sna/0000755000176200001440000000000014667263621011050 5ustar liggesuserssna/INDEX0000644000176200001440000002721711361527120011634 0ustar liggesusersadd.isolates Add Isolates to a Graph as.edgelist.sna sna Coercion Functions bbnam Butts' (Hierarchical) Bayesian Network Accuracy Model bbnam.bf Estimate Bayes Factors for the bbnam betweenness Compute the Betweenness Centrality Scores of Network Positions bicomponent.dist Calculate the Bicomponents of a Graph blockmodel Generate Blockmodels Based on Partitions of Network Positions blockmodel.expand Generate a Graph (or Stack) from a Given Blockmodel Using Particular Expansion Rules bn Fit a Biased Net Model bonpow Find Bonacich Power Centrality Scores of Network Positions brokerage Perform a Gould-Fernandez Brokerage Analysis centralgraph Find the Central Graph of a Labeled Graph Stack centralization Find the Centralization of a Given Network, for Some Measure of Centrality clique.census Compute Cycle Census Information closeness Compute the Closeness Centrality Scores of Network Positions coleman Coleman's High School Friendship Data component.dist Calculate the Component Size Distribution of a Graph components Find the Number of (Maximal) Components Within a Given Graph connectedness Compute Graph Connectedness Scores consensus Estimate a Consensus Structure from Multiple Observations cug.test Univariate Conditional Uniform Graph Tests cugtest Perform Conditional Uniform Graph (CUG) Hypothesis Tests for Graph-Level Indices cutpoints Identify the Cutpoints of a Graph or Digraph degree Compute the Degree Centrality Scores of Network Positions diag.remove Remove the Diagonals of Adjacency Matrices in a Graph Stack dyad.census Compute a Holland and Leinhardt MAN Dyad Census efficiency Compute Graph Efficiency Scores ego.extract Extract Egocentric Networks from Complete Network Data equiv.clust Find Clusters of Positions Based on an Equivalence Relation eval.edgeperturbation Compute the Effects of Single-Edge Perturbations on Structural Indices evcent Find Eigenvector Centrality Scores of Network Positions event2dichot Convert an Observed Event Matrix to a Dichotomous matrix flowbet Calculate Flow Betweenness Scores of Network Positions gapply Apply Functions Over Vertex Neighborhoods gclust.boxstats Plot Statistics Associated with Graph Clusters gclust.centralgraph Get Central Graphs Associated with Graph Clusters gcor Find the (Product-Moment) Correlation Between Two or More Labeled Graphs gcov Find the Covariance(s) Between Two or More Labeled Graphs gden Find the Density of a Graph gdist.plotdiff Plot Differences in Graph-level Statistics Against Inter-graph Distances gdist.plotstats Plot Various Graph Statistics Over a Network MDS geodist Fund the Numbers and Lengths of Geodesics Among Nodes in a Graph gliop Return a Binary Operation on GLI Values Computed on Two Graphs gplot Two-Dimensional Visualization of Graphs gplot.arrow Add Arrows or Segments to a Plot gplot.layout Vertex Layout Functions for gplot gplot.loop Add Loops to a Plot gplot.target Display a Graph in Target Diagram Form gplot.vertex Add Vertices to a Plot gplot3d Three-Dimensional Visualization of Graphs gplot3d.arrow Add Arrows a Three-Dimensional Plot gplot3d.layout Vertex Layout Functions for gplot3d gplot3d.loop Add Loops to a Three-Dimensional Plot graphcent Compute the (Harary) Graph Centrality Scores of Network Positions grecip Compute the Reciprocity of an Input Graph or Graph Stack gscor Find the Structural Correlations Between Two or More Graphs gscov Find the Structural Covariance(s) Between Two or More Graphs gt Transpose an Input Graph gtrans Compute the Transitivity of an Input Graph or Graph Stack gvectorize Vectorization of Adjacency Matrices hdist Find the Hamming Distances Between Two or More Graphs hierarchy Compute Graph Hierarchy Scores infocent Find Information Centrality Scores of Network Positions interval.graph Convert Spell Data to Interval Graphs is.connected Is a Given Graph Connected? is.isolate Is Ego an Isolate? isolates List the Isolates in a Graph or Graph Stack kcores Compute the k-Core Structure of a Graph kpath.census Compute Path or Cycle Census Information lab.optimize Optimize a Bivariate Graph Statistic Across a Set of Accessible Permutations lnam Fit a Linear Network Autocorrelation Model loadcent Compute the Load Centrality Scores of Network Positions lower.tri.remove Remove the Lower Triangles of Adjacency Matrices in a Graph Stack lubness Compute Graph LUBness Scores make.stochastic Make a Graph Stack Row, Column, or Row-column Stochastic maxflow Calculate Maximum Flows Between Vertices mutuality Find the Mutuality of a Graph nacf Sample Network Covariance and Correlation Functions neighborhood Compute Neighborhood Structures of Specified Order netcancor Canonical Correlation for Labeled Graphs netlm Linear Regression for Network Data netlogit Logistic Regression for Network Data npostpred Take Posterior Predictive Draws for Functions of Networks nties Find the Number of Possible Ties in a Given Graph or Graph Stack numperm Get the nth Permutation Vector by Periodic Placement plot.bbnam Plotting for bbnam Objects plot.blockmodel Plotting for blockmodel Objects plot.cugtest Plotting for cugtest Objects plot.equiv.clust Plot an equiv.clust Object plot.lnam Plotting for lnam Objects plot.qaptest Plotting for qaptest Objects plot.sociomatrix Plot Matrices Using a Color/Intensity Grid potscalered.mcmc Compute Gelman and Rubin's Potential Scale Reduction Measure for a Markov Chain Monte Carlo Simulation prestige Calculate the Vertex Prestige Scores print.bayes.factor Printing for Bayes Factor Objects print.bbnam Printing for bbnam Objects print.blockmodel Printing for blockmodel Objects print.cugtest Printing for cugtest Objects print.lnam Printing for lnam Objects print.netcancor Printing for netcancor Objects print.netlm Printing for netlm Objects print.netlogit Printing for netlogit Objects print.qaptest Printing for qaptest Objects print.summary.bayes.factor Printing for summary.bayes.factor Objects print.summary.bbnam Printing for summary.bbnam Objects print.summary.blockmodel Printing for summary.blockmodel Objects print.summary.cugtest Printing for summary.cugtest Objects print.summary.lnam Printing for summary.lnam Objects print.summary.netcancor Printing for summary.netcancor Objects print.summary.netlm Printing for summary.netlm Objects print.summary.netlogit Printing for summary.netlogit Objects print.summary.qaptest Printing for summary.qaptest Objects pstar Fit a p*/ERG Model Using a Logistic Approximation qaptest Perform Quadratic Assignment Procedure (QAP) Hypothesis Tests for Graph-Level Statistics reachability Find the Reachability Matrix of a Graph read.dot Read Graphviz DOT Files read.nos Read (N)eo-(O)rg(S)tat Input Files redist Find a Matrix of Distances Between Positions Based on Regular Equivalence rgbn Draw from a Skvoretz-Fararo Biased Net Process rgnm Draw Density-Conditioned Random Graphs rgnmix Draw Mixing-Conditioned Random Graphs rgraph Generate Bernoulli Random Graphs rguman Draw Dyad Census-Conditioned Random Graphs rgws Draw From the Watts-Strogatz Rewiring Model rmperm Randomly Permute the Rows and Columns of an Input Matrix rperm Draw a Random Permutation Vector with Exchangeability Constraints sdmat Estimate the Structural Distance Matrix for a Graph Stack sedist Find a Matrix of Distances Between Positions Based on Structural Equivalence sna Tools for Social Network Analysis sna-deprecated Deprecated Functions in sna Package sna.operators Graphical Operators sr2css Convert a Row-wise Self-Report Matrix to a CSS Matrix with Missing Observations stackcount How Many Graphs are in a Graph Stack? stresscent Compute the Stress Centrality Scores of Network Positions structdist Find the Structural Distances Between Two or More Graphs structure.statistics Compute Network Structure Statistics summary.bayes.factor Detailed Summaries of Bayes Factor Objects summary.bbnam Detailed Summaries of bbnam Objects summary.blockmodel Detailed Summaries of blockmodel Objects summary.cugtest Detailed Summaries of cugtest Objects summary.lnam Detailed Summaries of lnam Objects summary.netcancor Detailed Summaries of netcancor Objects summary.netlm Detailed Summaries of netlm Objects summary.netlogit Detailed Summaries of netlogit Objects summary.qaptest Detailed Summaries of qaptest Objects symmetrize Symmetrize an Adjacency Matrix triad.census Compute the Davis and Leinhardt Triad Census triad.classify Compute the Davis and Leinhardt Classification of a Given Triad upper.tri.remove Remove the Upper Triangles of Adjacency Matrices in a Graph Stack write.dl Write Output Graphs in DL Format write.nos Write Output Graphs in (N)eo-(O)rg(S)tat Format sna/MD50000644000176200001440000002402114667263621011357 0ustar liggesusers9ba5884ddab488cf320c3989f1c882ff *COPYING 0d35c8528d26b2f18d71e1f3ce62018b *ChangeLog 8aefb977631d6948c033a187ac8c5ad4 *DESCRIPTION 4afcba807dbe3ac044e626952117c0e2 *INDEX 98acd659dc2a3896479842d132ce04b5 *NAMESPACE 785b6a5b375a34a774ea41336c385df3 *R/connectivity.R 7439aaccb05dad6abeefe54832d84f70 *R/dataprep.R fd7bd3200a43c30463945c1cd861c9fd *R/fileio.R 4b4c5df094987b7babfabd78f57e86dd *R/gli.R 5e8579cc4006133696516695b16b9b91 *R/gmultiv.R a1e64ce8edfe5767797883343c2db671 *R/gtest.R 67969c3a1c637edd97b1ac7469616194 *R/models.R dc4bc76b0b9da4c9cd1b812194b00d9b *R/nli.R f7d3fabffa5c1155882bfde1769d45e9 *R/permutation.R e92d28f5cf2749e2254ff60eea02422c *R/randomgraph.R 12836f351f89c71658b818ac77ac9ab4 *R/roles.R b6ffb59d4315fb3d1125e1ab2263affc *R/sna-operators.R c41262b9aa29c60627c12c4f59fa230f *R/visualization.R a4ee6b0be67c291e592ee775b40ce43a *R/zzz.R 417b3ab638faeb3dcffecab3b7592f55 *data/coleman.RData d0d2b588bf2ad1a69f2ce1cde9f6535a *man/add.isolates.Rd 8c55a95054368e16d2871b916524dc33 *man/bbnam.Rd c27c49c4a2a2bb18199b099b2f46ef5e *man/bbnam.bf.Rd 50421c6e85818c6032c842e886c30375 *man/betweenness.Rd 592d146b7b5ad1b7a01c10ff08cf2bf5 *man/bicomponent.dist.Rd 193939477aa4618c77b0ea375583624b *man/blockmodel.Rd 42e5477572b4ff8369ab1ca451855175 *man/blockmodel.expand.Rd 887628aef7488b0e19f6c696e2ed58d0 *man/bn.Rd 1e136bce98ffd4836cf69a7434f76a63 *man/bonpow.Rd bd9acca55032c378b38580979d0334d5 *man/brokerage.Rd 99d1cb6a307893121697ee6e6215c1e7 *man/centralgraph.Rd 17546902d32e493121d44e5510f9cd67 *man/centralization.Rd d218868e28893dfd96c6876efc03727a *man/clique.census.Rd 39f79c47e3e9c4857388ee2cbe0176b0 *man/closeness.Rd b52a01e164cf21eb59754647ca939397 *man/coleman.Rd 866ef6e893aa146322abac4ce9ef1133 *man/component.dist.Rd 749c9e53f609b93111aeb3d5a9a8d310 *man/component.size.byvertex.Rd 043c5ac59e0b4b00a137fed97b9c0c85 *man/components.Rd ddf75813c192bfbd3d4de8ebf7a3b4d2 *man/connectedness.Rd 149c93060eece04bdadfae3ff40c64d7 *man/consensus.Rd b2c0d9b60c2fcc3e2ef21ff616209af2 *man/cug.test.Rd fc7fead4d2b9608176ae83a9f4c1ddde *man/cugtest.Rd 8be6afb544ba35ad81ce9db1d7fceb9c *man/cutpoints.Rd 76608787d80199556e199f0579ea733b *man/degree.Rd cba93ba78f3ac0eb7c0b3fcc17fbc331 *man/diag.remove.Rd 8e090b63c2be82f996832707b408f089 *man/dyad.census.Rd f42d313f4bcc9627e001b5fa04a73c32 *man/efficiency.Rd 0012d60c69595af59589c2d59b99f96b *man/ego.extract.Rd 85380fc94ca410bc11f9fc48adecac41 *man/equiv.clust.Rd 8f3445cbbfe65410b42ef8e8cabfd36f *man/eval.edgeperturbation.Rd 2d1aac6e9c87fba3c6eca875ec9809a0 *man/evcent.Rd 9cf48b3c8ddc715d638e896764985d60 *man/event2dichot.Rd cd94229beea4e93d91d140dc8a5d50fa *man/flowbet.Rd 9c01a80cda320b3eb45f6bddc77dba11 *man/gapply.Rd d575256f68e29e3ef0e638bba01ec8ee *man/gclust.boxstats.Rd fa63ac4c29fa74f1a3995a9966b1f2ee *man/gclust.centralgraph.Rd eb00fb40d26887507f548edc09cd02b5 *man/gcor.Rd c3065854284f792a75832ab39601fd53 *man/gcov.Rd e730f3116cbe62bc87087dbaf3d580f2 *man/gden.Rd f039565add28542f3453fd4a333f1d3f *man/gdist.plotdiff.Rd 2194bad8d83ea0eacb5c2c874c534e87 *man/gdist.plotstats.Rd aba14f0e54500d4aaac0c619b9551ef1 *man/geodist.Rd cdd3c4e722fbb2d5575dec3851940e65 *man/gilschmidt.Rd 71f64aab86ae2e5c5d190e1d58bcdc91 *man/gliop.Rd 6523459d0959b53ec658c50616a6fb55 *man/gplot.Rd 63dfc674d1d76800880b154526762d2d *man/gplot.arrow.Rd 00f70e95a56657384fe51e9147cb9eee *man/gplot.layout.Rd f18bb78f2e13f37b0498d07c0e159968 *man/gplot.loop.Rd a6cb1599334f568bd68bc57d617c0e4d *man/gplot.target.Rd 35fabddb77f71d466d0d64a8440c0b9b *man/gplot.vertex.Rd 9269b7e898095a1873be367148c3de48 *man/gplot3d.Rd ad99c894f55a04face687bf57152d4e2 *man/gplot3d.arrow.Rd e2fbced413db02fd7ea349d5690713e3 *man/gplot3d.layout.Rd 0576491bdec44440d105faea0fd587d5 *man/gplot3d.loop.Rd fe9c4db1860281622959effe44067ac0 *man/graphcent.Rd 3473e4b3cf2e84b819d30e14e37ba6e2 *man/grecip.Rd a9af052ecb65cc6b8ed197f07f9d38c9 *man/gscor.Rd 7b766e9ff05d503d953e2ac041bcdf17 *man/gscov.Rd 415bd428f263bc74cebd1df0a57fb31b *man/gt.Rd f31598a8188b08534920fd93f2acb87e *man/gtrans.Rd 8f9ec5940da32f6a82b840752e153624 *man/gvectorize.Rd 1f0440473a26a13b7c33cde97abc66a0 *man/hdist.Rd 6a37a9b40b1e8f3e33e866dff39c75d7 *man/hierarchy.Rd 2b21497eaca8144a308e459456bf9ef0 *man/infocent.Rd c0713f4475075d24220de0170ebbf814 *man/interval.graph.Rd 2ddcb4a96131f9324af1c12a9dc40f60 *man/is.connected.Rd 12e4bda29685c877ac2b5289db212967 *man/is.isolate.Rd 262112e5e5c5216a5031fe878324c719 *man/isolates.Rd b6dbdbafe73d040205761df6837ed412 *man/kcores.Rd 8fd8dd6f59fe8494d115e7fd61d6b24f *man/lab.optimize.Rd 8e4cfe778a937ad1b53dccc4404a5cf2 *man/lnam.Rd af0bb05a86e108ca8f39ef293c2d6705 *man/loadcent.Rd bdee13ab2c40d0284cf868d6a0285e23 *man/lower.tri.remove.Rd c6d99d634dc73a655c8c48acd1da358b *man/lubness.Rd 102a54529e204f494aa3feec992d4081 *man/make.stochastic.Rd 44e792811edb0245debca6a8d18fe8fa *man/maxflow.Rd 7ab22fc6c7b7e176e348990498be85ec *man/mutuality.Rd 75e20d8fd0bce5502de51259181e568a *man/nacf.Rd 0f745dd851b2dfa3916da637505f9155 *man/neighborhood.Rd 86802da92fcf5291f469541b5e5765f0 *man/netcancor.Rd 1527eb0a635e527b0f40c1d92037b093 *man/netlm.Rd 67cdbb36e1040985897a5b25f64fe658 *man/netlogit.Rd 88e1a9f7fd5f63bcdb675523e2179da2 *man/npostpred.Rd e3b9937479169f9289688e3d30234e12 *man/nties.Rd f086fc55aa2519e31ca5f0f1b6201942 *man/numperm.Rd 2afd0258db7d37ae2862182dbe276355 *man/path.census.Rd 69c26279ec59005f2e70b02d1ba7e962 *man/plot.bbnam.Rd d4c8bf11ad45582869172d7950dc391e *man/plot.blockmodel.Rd a6d5df4389947eaa5f6d5218b974a884 *man/plot.cugtest.Rd 0cac823cfc703b9defea43a8326ff375 *man/plot.equiv.clust.Rd a26934cd480d921453bae37174169240 *man/plot.lnam.Rd 01c4d2cc1096a3342d3617d7488d989a *man/plot.qaptest.Rd a0cc162c508aa99f1902dca80faefbf8 *man/plot.sociomatrix.Rd bcad40d5121622756155a0b4ebc2145e *man/potscalered.mcmc.Rd 499696f6de0d5d38dbc97321ab3b9f7d *man/prestige.Rd 5f6f947c93f04de34def7338844f3a8f *man/print.bayes.factor.Rd a86b03705a88bf312459cd3bd1f4b62a *man/print.bbnam.Rd a930edf1e51c66195b8afac50d24cf9c *man/print.blockmodel.Rd 375b9ee999b4861e1d040d372e786764 *man/print.cugtest.Rd 43166c4286c7d2eca8b0fe21ed97b726 *man/print.lnam.Rd 80c141fe3c869163c29c84d793ec4c9b *man/print.netcancor.Rd 23dc1b9cd00a763d95ce2219f0832016 *man/print.netlm.Rd ccc9091ff063421c35c4fd0bdd4eafbd *man/print.netlogit.Rd b5a1e1177cb19f8e736ab6c3968f1b80 *man/print.qaptest.Rd 0aab1cb5278f84f543d673e839b10ede *man/print.summary.bayes.factor.Rd 1b12cdbd0fce988b8d0db820ec352582 *man/print.summary.bbnam.Rd ce8a3d3a327615a9a94a7036d43cee4b *man/print.summary.blockmodel.Rd f67c924baa4522e255e9793f60411456 *man/print.summary.cugtest.Rd c35d7402bf5d49beead7de4a4016b0b4 *man/print.summary.lnam.Rd aee57815ba34fa9760671a33d577bece *man/print.summary.netcancor.Rd ee843a50fb36e01a87006d45c0e1ceec *man/print.summary.netlm.Rd 8feeeaf4160b4ae732ce04b85078b3e6 *man/print.summary.netlogit.Rd 45b7d396449e5fbb71df931a834b5ed4 *man/print.summary.qaptest.Rd 9c8d983a2399b9b31f4c39b9ac7cd29d *man/pstar.Rd b998e9a8fe3293dd7b076b839211bbc2 *man/qaptest.Rd ca2b59aebcae210dc09c1c534f2128c6 *man/reachability.Rd 9ba3a90b1bd2d9159dd9cb9899788613 *man/read.dot.Rd 3ad551092bf9fcd8b5fd6023701e8ea2 *man/read.nos.Rd 3896378a2b499b3dbe929838aaa4af3b *man/redist.Rd 6ccd92656dcc723b097c68e6350e911d *man/rgbn.Rd 742436c8a1ef9a22f6338b14343de1f7 *man/rgnm.Rd 6a6619b39555bcde8c99d2f9c05f394e *man/rgnmix.Rd a98f8f72e5743bda4747d7304fbf36c5 *man/rgraph.Rd 14492ec7ac7ee767ea779f07d78a9c44 *man/rguman.Rd ab9ba330160e0859241823f0ac8555e4 *man/rgws.Rd 22212780815cf47cc92ae13e83c26e8a *man/rmperm.Rd 85af5f3eefa68904b9bd875d2a6aa535 *man/rperm.Rd bac6e23361646f61e281d9b1ecbe4682 *man/sdmat.Rd 47ea66394fe28d6dcc7ebcb832a9ffe5 *man/sedist.Rd 072d4579f8e817d65b7500c21d0cef29 *man/simmelian.Rd dab502c90beb4920cdbb5ebe1ed759f2 *man/sna-coercion.Rd 2612a6d8d8ac193ced95d72c9932a050 *man/sna-defunct.Rd 1b5bd86e9dd621ebea9f1747d26cddf0 *man/sna-deprecated.Rd 5c422d15e4140edaafde5496de37f93a *man/sna-internal.Rd 4d0069ff9188542df0669209df303dc9 *man/sna.Rd c6da10c0b52e898e149793df017c17ba *man/sna.operators.Rd 71a6e6e5fd32209adea054ce43fbe9fa *man/sr2css.Rd 1e0979cc439cd88b573bc0a2685b739b *man/stackcount.Rd 1aca7c316efef0c957351e5312785703 *man/stresscent.Rd a5d2c833f8e3d34ebda1318e960fc7d3 *man/structdist.Rd 201920ef520dea151031586026e8abde *man/structure.statistics.Rd e0647a6c8f903795c5a9fccf4106b7c7 *man/summary.bayes.factor.Rd 27d99e2c2594742e17088f28c7a2a679 *man/summary.bbnam.Rd 2ac69e791655faa2996c5c2bd3b58e05 *man/summary.blockmodel.Rd 934bd02b812b14d722f926bd92d65ea0 *man/summary.cugtest.Rd 0c5f6cdeaabd74084564bea4c655c612 *man/summary.lnam.Rd a2e3e2d164b9edfa5e9a7dde310675bd *man/summary.netcancor.Rd 89e10f82ccb5cb9c309c0ceb9840faa1 *man/summary.netlm.Rd 7755e6929040e76adb59c10a904eac03 *man/summary.netlogit.Rd 3afc754f8c6a58fbf9fa8749d720bfa6 *man/summary.qaptest.Rd 2b87abc709483db0d84f7e01bb6013da *man/symmetrize.Rd ca0638fe16e3793415c7d9cdcfd90828 *man/triad.census.Rd 53a62c558147b7d8d6afec0b2ff99cb9 *man/triad.classify.Rd fd22582a85c0708915bae84a1f96ae9c *man/upper.tri.remove.Rd 5ab4e8d4892ed9030c6a1a0555d59ac2 *man/write.dl.Rd afe8f0639d303448a276a9e9e2091887 *man/write.nos.Rd 218857de86c8d73002c9f66f71e5b735 *src/Rinit.c ec50ca6ccb490a62998881d4df02bca3 *src/cohesion.c 0213ecd1bd63b8c926ccb2f2b8991613 *src/cohesion.h 5aa178a1daf8f3610266db8682c41d16 *src/components.c 77fce5fd2e57613f5c102019ef0a8856 *src/components.h bead4264968e3255bb29d5d2c5406dd4 *src/geodist.c f6deb2e2597912685a6c62bacaebf286 *src/geodist.h d74ea885f10a760e37a18bab3dda9d57 *src/gli.c f080d84e34176c4d67efc21a2c42899c *src/gli.h f95247607f76a781f3cc49bde3141de5 *src/layout.c 378d12e950d663b87a12c70782501471 *src/layout.h 0734dac885a13966ac65089ae284c524 *src/likelihood.c d814e2e7e9f9dcfc20e64a54b4ba953d *src/likelihood.h 3e5358c34066aa58ef7168b68cd99886 *src/nli.c 9933b5d2ee1ab4788d922311815e6d04 *src/nli.h 48c1a5d72c9b1a68074ac71ab0ef304f *src/paths.c cbab6598ea2aed880f43c845c72205fb *src/paths.h c53fb34cb6b766f764cf70536b3dc9f3 *src/randomgraph.c 98e58851b8f745fb79db460c743382f3 *src/randomgraph.h 5cf6fc518ef9c91a8f2c681814b0bc08 *src/triads.c bbebed11dd9f0fabc1bc0135874e699c *src/triads.h 6125fd08e26edd425fd67f0f17acfc88 *src/utils.c 8bf40b968d70c8314052152f2b12194b *src/utils.h sna/R/0000755000176200001440000000000014667253552011253 5ustar liggesuserssna/R/randomgraph.R0000644000176200001440000003520614667247067013712 0ustar liggesusers###################################################################### # # randomgraph.R # # copyright (c) 2004, Carter T. Butts # Last Modified 02/28/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains various routines for random graph generation in # R. # # Contents: # rewire.ud # rewire.ws # rgbn # rgmn # rgnmix # rgraph # rguman # rgws # ###################################################################### #rewire.ud - Perform a uniform dyadic rewiring of a graph or graph stack rewire.ud<-function(g,p,return.as.edgelist=FALSE){ #Pre-process the raw input g<-as.sociomatrix.sna(g) if(is.list(g)) return(lapply(g,rewire.ud,p=p)) #End pre-processing #Coerce g to an array if(length(dim(g))==2) g<-array(g,dim=c(1,NROW(g),NCOL(g))) n<-dim(g)[1] nv<-dim(g)[2] #Perform the rewiring, and return the result rewired<-.C("udrewire_R",g=as.double(g),as.double(n),as.double(nv), as.double(p),PACKAGE="sna") if(!return.as.edgelist) array(rewired$g,dim=c(n,nv,nv)) else as.edgelist.sna(array(rewired$g,dim=c(n,nv,nv))) } #rewire.ws - Perform a Watts-Strogatz rewiring of a graph or graph stack rewire.ws<-function(g,p,return.as.edgelist=FALSE){ #Pre-process the raw input g<-as.sociomatrix.sna(g) if(is.list(g)) return(lapply(g,rewire.ud,p=p)) #End pre-processing #Coerce g to an array if(length(dim(g))==2) gi<-array(g,dim=c(1,NROW(g),NCOL(g))) go<-gi n<-dim(gi)[1] nv<-dim(gi)[2] #Perform the rewiring, and return the result rewired<-.C("wsrewire_R",as.double(gi),go=as.double(go),as.double(n), as.double(nv),as.double(p),PACKAGE="sna") if(!return.as.edgelist) array(rewired$go,dim=c(n,nv,nv)) else as.edgelist.sna(array(rewired$go,dim=c(n,nv,nv))) } #rgbn - Draw from a biased net model rgbn<-function(n, nv, param=list(pi=0, sigma=0, rho=0, d=0.5, delta=0, epsilon=0), burn=nv*nv*5*1e2, thin=nv*nv*5, maxiter=1e7, method=c("mcmc","cftp"), dichotomize.sib.effects=FALSE, return.as.edgelist=FALSE, seed.graph=NULL, max.density=1){ #Allocate memory for the graphs (and initialize) g<-array(0,dim=c(n,nv,nv)) if(!is.null(seed.graph)){ seed.graph<-as.sociomatrix.sna(seed.graph) if(length(dim(seed.graph))>2) g[1,,]<-seed.graph[1,,] else g[1,,]<-seed.graph } #Get the parameter vector p<-rep(0,4) if(!is.null(param$pi)) p[1]<-param$pi[1] if(!is.null(param$sigma)) p[2]<-param$sigma[1] if(!is.null(param$rho)) p[3]<-param$rho[1] if(!is.null(param$delta)) p[4]<-param$delta[1] if((p[4]>0)&&(match.arg(method)=="cftp")) stop("Satiation parameter (delta) not supported with CFTP at present; use MCMC instead.\n") if(!is.null(param$d)){ #Base event rates (convert to nv x nv form) d<-matrix(param$d,nv,nv) }else d<-matrix(0,nv,nv) if(!is.null(param$epsilon)){ #Inhibition events (in aggregate) - convert to nv x nv form if(any(param$epsilon>0)&&(match.arg(method)=="cftp")){ stop("Inhibition events (epsilon) not supported with CFTP at present; use MCMC instead.\n") } e<-matrix(param$epsilon,nv,nv) }else{ #Not using, by default e<-matrix(0,nv,nv) } #Take the draws early.termination<-FALSE #Flag for early termination if(match.arg(method)=="mcmc"){ sim<-.C("bn_mcmc_R",g=as.integer(g),as.double(nv),as.double(n), as.double(burn),as.integer(thin),as.double(p[1]),as.double(p[2]),as.double(p[3]),as.double(d), as.double(p[4]),as.double(e),as.integer(dichotomize.sib.effects), dm=as.double(max.density*nv*(nv-1)),PACKAGE="sna") g<-array(sim$g,dim=c(n,nv,nv)) early.termination<-sim$dm<0 #Make sure we didn't stop early }else{ if(any(d>0)){ #If d==0, just return empty graphs if(all(d==1)){ #If d==1, just return complete graphs (no delta support yet!) for(i in 1:n){ g[i,,]<-1 diag(g[i,,])<-0 } }else{ #OK, a nontrivial case. Let's go for it. d[d==0]<-1e-10 #CFTP algorithm not so happy with 0s d[d==1]<-1-1e-10 #Doesn't like exact 1s, either for(i in 1:n){ g[i,,]<-matrix(.C("bn_cftp_R",g=as.integer(g[i,,]),as.integer(nv), as.double(p[1]),as.double(p[2]),as.double(p[3]),as.double(d), as.integer(maxiter),as.integer(dichotomize.sib.effects),PACKAGE="sna",NAOK=TRUE)$g,nv,nv) } } } } #Return the result if(return.as.edgelist) out<-as.edgelist.sna(g) else{ if(dim(g)[1]==1) out<-g[1,,] else out<-g } if(early.termination) #Mark the output as tainted if necessary attr(out,"early.termination")<-TRUE out } #r[i]=1-u^i #p r[1]^(n-1) #p^2 (n-1)C1 (1-r[1]) r[2]^(n-2) #p^3 (n-1)C2 (1-r[1])(1-r[2]) r[3]^(n-3) #... #p^i (n-1)C(i-1) r[i]^(n-i) prod_j=1^{i-1} (1-r[j]) # = p^i (n-1)C(i-1) (1-u^i)^(n-i) u^{i(i-1)/2} #rgmn - Draw a density-conditioned graph rgnm<-function(n,nv,m,mode="digraph",diag=FALSE,return.as.edgelist=FALSE){ #Allocate the graph stack and related things g<-vector(mode="list",n) nv<-rep(nv,length=n) m<-rep(m,length=n) #Create the graphs for(i in 1:n){ if(nv[i]==0){ #Degenerate null graph if(m[i]>0) stop("Too many edges requested in rgnm.") else{ mat<-matrix(nrow=0,ncol=3) attr(mat,"n")<-0 } g[[i]]<-mat }else if(nv[i]==1){ #Isolate (perhaps w/loop) if(m[i]>diag) stop("Too many edges requested in rgnm.") if(m[i]==1){ mat<-matrix(c(1,1,1),nrow=1,ncol=3) attr(mat,"n")<-1 }else{ mat<-matrix(nrow=0,ncol=3) attr(mat,"n")<-1 } g[[i]]<-mat }else if(m[i]==0){ #Empty graph mat<-matrix(nrow=0,ncol=3) attr(mat,"n")<-nv[i] g[[i]]<-mat }else{ #Everything else if(mode=="digraph"){ if(diag){ #Digraph w/loops if(m[i]>nv[i]^2) stop("Too many edges requested in rgnm.") j<-sample(nv[i]^2,m[i]) r<-((j-1)%%nv[i])+1 c<-((j-1)%/%nv[i])+1 mat<-cbind(r,c,rep(1,m[i])) }else{ #Digraph, no loops if(m[i]>nv[i]*(nv[i]-1)) stop("Too many edges requested in rgnm.") j<-sample(nv[i]*(nv[i]-1),m[i]) c<-((j-1)%/%(nv[i]-1))+1 r<-(((j-1)%%(nv[i]-1))+1)+((((j-1)%%(nv[i]-1))+1)>(c-1)) mat<-cbind(r,c,rep(1,m[i])) } }else if(mode=="graph"){ if(diag){ #Unirected graph, w/loops if(m[i]>nv[i]*(nv[i]+1)/2) stop("Too many edges requested in rgnm.") j<-sample(nv[i]*(nv[i]+1)/2,m[i]) c<-nv[i]-floor(sqrt(1/4+2*(nv[i]*(nv[i]+1)/2-j))-1/2) r<-j+nv[i]-c*(nv[i]+1)+c*(c+1)/2 mat<-cbind(r,c,rep(1,m[i])) mat<-rbind(mat,cbind(c,r,rep(1,m[i]))) }else{ #Undirected graph, no loops if(m[i]>nv[i]*(nv[i]-1)/2) stop("Too many edges requested in rgnm.") j<-sample(nv[i]*(nv[i]-1)/2,m[i]) c<-nv[i]-1-floor(sqrt(1/4+2*(choose(nv[i],2)-j))-1/2) r<-j-(c-1)*nv[i]+c*(c-1)/2+c mat<-cbind(r,c,rep(1,m[i])) mat<-rbind(mat,cbind(c,r,rep(1,m[i]))) } }else stop("Unsupported mode in rgnm.") attr(mat,"n")<-nv[i] #Set graph size g[[i]]<-mat } } #Return the results if(!return.as.edgelist) as.sociomatrix.sna(g) else{ if(n>1) g else g[[1]] } } #Simple function to produce graphs with fixed exact or expected mixing #matrices. n should be the number of desired graphs, tv a vector of types, #and mix a mixing matrix whose rows and columns correspond to the entries of #tv. If method==probability, mix[i,j] should contain the probability of #an edge from a vertex of type i to one of type j; otherwise, mix[i,j] should #contain the number of ties from vertices of type i to those of type j in #the resulting graph. rgnmix<-function (n, tv, mix, mode="digraph", diag=FALSE, method=c("probability", "exact"), return.as.edgelist=FALSE) { if(match.arg(method)=="probability"){ #If method==probability, call rgraph return(rgraph(n=length(tv),m=n,tprob=mix[tv,tv],mode=mode,diag=diag,return.as.edgelist=return.as.edgelist)) }else{ #Otherwise, use the exact method g<-array(0,dim=c(n,length(tv),length(tv))) if(is.character(tv)){ if(is.null(rownames(mix))) stop("Vertex types may only be given as characters for mixing matrices with applicable rownames.\n") tv<-match(tv,rownames(mix)) } tcounts<-tabulate(tv,NROW(mix)) if(mode=="graph"){ for(i in 1:n){ for(j in 1:NROW(mix)) #Row types if(tcounts[j]>0){ # (ignore if none of type j) for(k in j:NROW(mix)) #Col types if(tcounts[k]>0){ # (ignore if none of type k) if(j==k){ #Diagonal case if(tcounts[j]==1){ # Single entry if(diag) g[i,tv==j,tv==k]<-mix[j,k] }else if((tcounts[j]==2)&&(!diag)){ # Stupid hack for rgnm bug if(mix[j,k]) g[i,tv==j,tv==k]<-rbind(c(0,1),c(1,0)) }else{ # Multiple entries g[i,tv==j,tv==k]<-rgnm(n=1,nv=tcounts[j],m=mix[j,k], mode="graph",diag=diag) } }else{ #Off-diagonal case g[i,tv==j,tv==k][sample(1:(tcounts[j]*tcounts[k]),mix[j,k], replace=FALSE)]<-1 } } } g[i,,]<-g[i,,]|t(g[i,,]) #Symmetrize } }else{ for(i in 1:n){ for(j in 1:NROW(mix)) #Row types if(tcounts[j]>0){ # (ignore if none of type j) for(k in 1:NROW(mix)) #Col types if(tcounts[k]>0){ # (ignore if none of type k) if(j==k){ #Diagonal case if(tcounts[j]==1){ # Single entry if(diag) g[i,tv==j,tv==k]<-mix[j,k] }else{ # Multiple entries g[i,tv==j,tv==k]<-rgnm(n=1,nv=tcounts[j],m=mix[j,k], mode="digraph",diag=diag) } }else{ #Off-diagonal case g[i,tv==j,tv==k][sample(1:(tcounts[j]*tcounts[k]),mix[j,k], replace=FALSE)]<-1 } } } } } } #Return the result if (n==1) g<-g[1,,] if(return.as.edgelist) as.edgelist.sna(g) else g } #rgraph - Draw a Bernoulli graph. rgraph<-function(n,m=1,tprob=0.5,mode="digraph",diag=FALSE,replace=FALSE,tielist=NULL,return.as.edgelist=FALSE){ if(is.null(tielist)){ #Draw using true Bernoulli methods g<-list() directed<-(mode=="digraph") if(length(dim(tprob))>3) stop("tprob must be a single element, vector, matrix, or 3-d array.") if(length(dim(tprob))==3){ pmode<-3 if((dim(tprob)[1]!=m)||(dim(tprob)[2]!=n)||(dim(tprob)[3]!=n)) stop("Incorrect tprob dimensions.") }else if(length(dim(tprob))==2){ pmode<-3 if((dim(tprob)[1]!=n)||(dim(tprob)[2]!=n)) stop("Incorrect tprob dimensions.") }else{ pmode<-0 tprob<-rep(tprob,length=m) } for(i in 1:m){ if(length(dim(tprob))==3) g[[i]]<-.Call("rgbern_R",n,tprob[i,,],directed,diag,pmode,PACKAGE="sna") else if(length(dim(tprob))==2) g[[i]]<-.Call("rgbern_R",n,tprob,directed,diag,pmode,PACKAGE="sna") else g[[i]]<-.Call("rgbern_R",n,tprob[i],directed,diag,pmode,PACKAGE="sna") } #Return the result if(return.as.edgelist){ if(m==1) g[[1]] else g }else as.sociomatrix.sna(g) }else{ #Draw using edge value resampling g<-array(dim=c(m,n,n)) if(length(dim(tielist))==3){ for(i in 1:m) g[i,,]<-array(sample(as.vector(tielist[i,,]),n*n,replace=replace), dim=c(n,n)) }else{ for(i in 1:m) g[i,,]<-array(sample(as.vector(tielist),n*n,replace=replace),dim=c(n,n)) } if(!diag) for(i in 1:m) diag(g[i,,])<-0 if(mode!="digraph") for(i in 1:m){ temp<-g[i,,] temp[upper.tri(temp)]<-t(temp)[upper.tri(temp)] g[i,,]<-temp } #Return the result if(!return.as.edgelist){ if(m==1) g[1,,] else g }else as.edgelist.sna(g) } } #rguman - Draw from the U|MAN graph distribution rguman<-function(n,nv,mut=0.25,asym=0.5,null=0.25,method=c("probability","exact"),return.as.edgelist=FALSE){ #Create the output structure g<-array(0,dim=c(n,nv,nv)) #Create the dyad list dl<-matrix(1:(nv^2),nv,nv) dlu<-dl[upper.tri(dl)] dll<-t(dl)[upper.tri(dl)] ndl<-length(dlu) #Number of dyads #Perform a reality check if((match.arg(method)=="exact")&&(mut+asym+null!=ndl)) stop("Sum of dyad counts must equal number of dyads for method==exact.\n") else if((match.arg(method)=="probability")&&(mut+asym+null!=1)){ s<-mut+asym+null mut<-mut/s; asym<-asym/s; null<-null/s } #Draw the graphs for(i in 1:n){ #Determine the number of dyads in each class if(match.arg(method)=="probability"){ mc<-rbinom(1,ndl,mut) ac<-rbinom(1,ndl-mc,asym/(asym+null)) nc<-ndl-mc-ac }else{ mc<-mut ac<-asym nc<-null } #Draw the dyad states ds<-sample(rep(1:3,times=c(mc,ac,nc))) #Place edges accordingly if(mc>0){ g[i,,][dlu[ds==1]]<-1 #Mutuals g[i,,][dll[ds==1]]<-1 } if(ac>0){ g[i,,][dlu[ds==2]]<-rbinom(ac,1,0.5) #Asymetrics g[i,,][dll[ds==2]]<-1-g[i,,][dlu[ds==2]] } } #Return the result if(return.as.edgelist) as.edgelist.sna(g) else{ if(n>1) g else g[1,,] } } #rgws - Draw a graph from the Watts-Strogatz model rgws<-function(n,nv,d,z,p,return.as.edgelist=FALSE){ #Begin by creating the lattice tnv<-nv^d temp<-vector() nums<-1:nv count<-tnv/nv for(i in 1:d){ temp<-cbind(temp,rep(nums,count)) nums<-rep(nums,each=nv) count<-count/nv } lat<-as.matrix(dist(temp,method="manhattan"))<=z #Identify nearest neighbors diag(lat)<-0 #Create n copies of the lattice if(n>1) lat<-apply(lat,c(1,2),rep,n) else lat<-array(lat,dim=c(1,tnv,tnv)) #Rewire the copies g<-lat lat<-array(.C("wsrewire_R",as.double(lat),g=as.double(g),as.double(n), as.double(tnv),as.double(p),PACKAGE="sna")$g,dim=c(n,tnv,tnv)) #Return the result if(return.as.edgelist) as.edgelist.sna(lat) else{ if(n>1) lat else lat[1,,] } } sna/R/gmultiv.R0000644000176200001440000006173014533477532013072 0ustar liggesusers###################################################################### # # gmultiv.R # # copyright (c) 2004, Carter T. Butts # Last Modified 8/5/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines associated with multivariate analysis of # graph sets. # # Contents: # centralgraph # gclust.boxstats # gclust.centralgraph # gcor # gcov # gdist.plotdiff # gdist.plotstats # gscor # gscov # hdist # sdmat # structdist # ###################################################################### #centralgraph - Find the central graph of a graph stack centralgraph<-function(dat,normalize=FALSE){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in centralgraph.") #End pre-processing #Check to see if someone foolishly called this with one graph if(length(dim(dat))==2) out<-dat else{ if(normalize) out<-apply(dat,c(2,3),mean,na.rm=TRUE) else out<-matrix(data=as.numeric(apply(dat,c(2,3),mean,na.rm=TRUE)>=0.5), nrow=dim(dat)[2],ncol=dim(dat)[2]) } out } #gclust.boxstats - Plot statistics associated with clusters gclust.boxstats<-function(h,k,meas,...){ #h must be an hclust object, k the number of groups, and meas the group measurement vector out<-matrix(nrow=length(meas),ncol=k) gmat<-matrix(nrow=length(meas),ncol=2) gmat[,1]<-c(1:length(meas)) gmat[,2]<-cutree(h,k=k) for(i in 1:k){ out[1:length(meas[gmat[gmat[,2]==i,1]]),i]<-meas[gmat[gmat[,2]==i,1]] } boxplot(data.frame(out),...) } #gclust.centralgraph - Get central graphs associated with clusters gclust.centralgraph<-function(h,k,dat,...){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in gclust.centralgraph.") #End pre-processing #h must be an hclust object, k the number of groups, and dat a collection #of graphs (with identical order) out<-array(dim=c(k,dim(dat)[2],dim(dat)[2])) gmat<-matrix(nrow=dim(dat)[1],ncol=2) gmat[,1]<-c(1:dim(dat)[1]) gmat[,2]<-cutree(h,k=k) for(i in 1:k) out[i,,]<-centralgraph(dat[gmat[gmat[,2]==i,1],,],...) out } #gcor - Correlation between two or more graphs. gcor<-function(dat,dat2=NULL,g1=NULL,g2=NULL,diag=FALSE,mode="digraph"){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in gcor.") if(!is.null(dat2)){ dat2<-as.sociomatrix.sna(dat2) if(is.list(dat2)) stop("Identical graph orders required in gcor.") } #End pre-processing #Collect data and various parameters if(is.null(g1)) g1<-1:dim(dat)[1] if(is.null(g2)) g2<-1:dim(dat)[1] if(!is.null(dat2)){ if(length(dim(dat))>2) temp1<-dat else{ temp1<-array(dim=c(1,dim(dat)[2],dim(dat)[2])) temp1[1,,]<-dat } if(length(dim(dat2))>2) temp2<-dat2 else{ temp2<-array(dim=c(1,dim(dat2)[2],dim(dat2)[2])) temp2[1,,]<-dat2 } if(dim(temp1)[2]>dim(temp2)[2]) temp2<-add.isolates(temp2,dim(temp1)[2]-dim(temp2)[2]) if(dim(temp2)[2]>dim(temp1)[2]) temp1<-add.isolates(temp1,dim(temp2)[2]-dim(temp1)[2]) n<-dim(temp1)[2] gn<-dim(temp1)[1]+dim(temp2)[1] gn1<-dim(temp1)[1] gn2<-dim(temp2)[1] d<-array(dim=c(gn,n,n)) d[1:gn1,,]<-temp1 d[(gn1+1):(gn2+gn1),,]<-temp2 g1<-1:gn1 g2<-(gn1+1):(gn1+gn2) }else{ d<-dat n<-dim(dat)[2] gn<-dim(dat)[1] gn1<-length(g1) gn2<-length(g2) } #Scrap the diagonals, if required if(!diag) d<-diag.remove(d) #Now, get rid of the upper triangle if these are simple graphs if(mode=="graph") d<-upper.tri.remove(d) #Compute the graph correlation matrix gd<-matrix(nrow=gn1,ncol=gn2) rownames(gd)<-g1 colnames(gd)<-g2 for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-cor(as.vector(d[g1[i],,]),as.vector(d[g2[j],,]), use="complete.obs") #If only one comparison requested, return as an element if((gn1==1)&(gn2==1)) gd[1,1] else gd } #gcov - Covariance between two or more graphs. gcov<-function(dat,dat2=NULL,g1=NULL,g2=NULL,diag=FALSE,mode="digraph"){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in gcov.") if(!is.null(dat2)){ dat2<-as.sociomatrix.sna(dat2) if(is.list(dat2)) stop("Identical graph orders required in gcov.") } #End pre-processing #Collect data and various parameters if(is.null(g1)) g1<-1:dim(dat)[1] if(is.null(g2)) g2<-1:dim(dat)[1] if(!is.null(dat2)){ if(length(dim(dat))>2) temp1<-dat else{ temp1<-array(dim=c(1,dim(dat)[2],dim(dat)[2])) temp1[1,,]<-dat } if(length(dim(dat2))>2) temp2<-dat2 else{ temp2<-array(dim=c(1,dim(dat2)[2],dim(dat2)[2])) temp2[1,,]<-dat2 } if(dim(temp1)[2]>dim(temp2)[2]) temp2<-add.isolates(temp2,dim(temp1)[2]-dim(temp2)[2]) if(dim(temp2)[2]>dim(temp1)[2]) temp1<-add.isolates(temp1,dim(temp2)[2]-dim(temp1)[2]) n<-dim(temp1)[2] gn<-dim(temp1)[1]+dim(temp2)[1] gn1<-dim(temp1)[1] gn2<-dim(temp2)[1] d<-array(dim=c(gn,n,n)) d[1:gn1,,]<-temp1 d[(gn1+1):(gn2+gn1),,]<-temp2 g1<-1:gn1 g2<-(gn1+1):(gn1+gn2) }else{ d<-dat n<-dim(dat)[2] gn<-dim(dat)[1] gn1<-length(g1) gn2<-length(g2) } #Scrap the diagonals, if required if(!diag) d<-diag.remove(d) #Now, get rid of the upper triangle if these are simple graphs if(mode=="graph") d<-upper.tri.remove(d) #Compute the graph covariance matrix gd<-matrix(nrow=gn1,ncol=gn2) rownames(gd)<-g1 colnames(gd)<-g2 for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-cov(as.vector(d[g1[i],,]),as.vector(d[g2[j],,]), use="complete.obs") #If only one comparison requested, return as an element if((gn1==1)&(gn2==1)) gd[1,1] else gd } #gdist.plotdiff - Plot differences in graph-level statistics against inter-graph distances gdist.plotdiff<-function(d,meas,method="manhattan",jitter=TRUE,xlab="Inter-Graph Distance",ylab="Measure Distance",lm.line=FALSE,...){ #Note that d must be a matrix of distances, and meas must be a matrix of measures #Create a matrix of differences in graph-level statistics md<-dist(meas,method=method) #Vectorize dv<-as.vector(as.dist(d)) mdv<-as.vector(md) if(jitter){ dv<-jitter(dv) mdv<-jitter(mdv) } #Plot the results plot(dv,mdv,xlab=xlab,ylab=ylab,...) #If needed, add a line fit abline(lm(mdv~dv),col="red") } #gdist.plotstats - Plot statistics associated with graphs against (projected) inter-graph distances gdist.plotstats<-function(d,meas,siz.lim=c(0,0.15),rescale="quantile",display.scale="radius",display.type="circleray",cex=0.5,pch=1,labels=NULL,pos=1,labels.cex=1,legend=NULL,legend.xy=NULL,legend.cex=1,...){ #d must be a matrix of distances (e.g., from structdist or hdist) and meas a matrix or vector of measures #Perform an MDS on the distances xy<-cmdscale(as.dist(d)) n<-dim(xy)[1] #Adjust and rescale the measure(s) prior to display if(is.null(dim(meas))) m<-matrix(meas,ncol=1) else m<-meas nm<-dim(m)[2] if(rescale=="quantile"){ #Rescale by (empirical) quantiles (ordinal rescaling) m<-apply(m,2,order) m<-sweep(m,2,apply(m,2,min)) m<-sweep(m,2,apply(m,2,max),"/") }else if(rescale=="affine"){ #Rescale the measure(s) by affine transformation to the [0,1] interval m<-sweep(m,2,apply(m,2,min)) m<-sweep(m,2,apply(m,2,max),"/") }else if(rescale=="normalize"){ #Rescale the measure(s) by their maximum values m<-sweep(m,2,apply(m,2,max),"/") } #Determine how large our drawn symbols are to be if(display.scale=="area") #If we're using area scaling, we need to take square roots m<-sqrt(m) msize<-m*siz.lim[2]+siz.lim[1] #Now, express the scaled measures as fractions of the plotting range pwid<-max(xy)-min(xy) #Grab width of plotting range msize<-msize*pwid #Adjust the msize matrix. #Plot the data plot(xy,xlab=expression(lambda[1]),ylab=expression(lambda[2]),cex=cex,pch=pch,xlim=c(min(xy),max(xy)),ylim=c(min(xy),max(xy)),...) #Plot the graphs' MDS positions if(display.type=="poly"){ #Plot measures using polygons for(i in 1:nm){ for(j in 1:n){ x<-xy[j,1]+sin(2*pi*((0:nm)/nm))*msize[j,i] y<-xy[j,2]+cos(2*pi*((0:nm)/nm))*msize[j,i] lines(x,y,col=i) } } }else if(display.type=="circle"){ #Plot measures using circles for(i in 1:nm){ for(j in 1:n){ x<-xy[j,1]+sin(2*pi*((0:500)/500))*msize[j,i] y<-xy[j,2]+cos(2*pi*((0:500)/500))*msize[j,i] lines(x,y,col=i) } } }else if(display.type=="ray"){ #Plot measures using rays for(i in 1:nm){ for(j in 1:n){ lines(c(xy[j,1],xy[j,1]+sin(2*pi*((i-1)/nm))*msize[j,i]),c(xy[j,2],xy[j,2]+cos(2*pi*((i-1)/nm))*msize[j,i]),col=i) } } }else if(display.type=="polyray"){ #Plot measures using polys and rays for(i in 1:nm){ for(j in 1:n){ x<-xy[j,1]+sin(2*pi*((0:nm)/nm))*msize[j,i] y<-xy[j,2]+cos(2*pi*((0:nm)/nm))*msize[j,i] lines(x,y,col=i) lines(c(xy[j,1],xy[j,1]+sin(2*pi*((i-1)/nm))*msize[j,i]),c(xy[j,2],xy[j,2]+cos(2*pi*((i-1)/nm))*msize[j,i]),col=i) } } }else if(display.type=="circleray"){ #Plot measures using circles and rays for(i in 1:nm){ for(j in 1:n){ x<-xy[j,1]+sin(2*pi*((0:500)/500))*msize[j,i] y<-xy[j,2]+cos(2*pi*((0:500)/500))*msize[j,i] lines(x,y,col=i) lines(c(xy[j,1],xy[j,1]+sin(2*pi*((i-1)/nm))*msize[j,i]),c(xy[j,2],xy[j,2]+cos(2*pi*((i-1)/nm))*msize[j,i]),col=i) } } } #Add labels, if needed if(!is.null(labels)) text(xy[,1],xy[,2],labels,pos=pos,cex=labels.cex) #Add legend? if(!is.null(legend)){ if(is.null(legend.xy)) legend.xy<-c(min(xy),max(xy)) legend(legend.xy[1],legend.xy[2],legend=legend,fill=1:nm,cex=legend.cex) } } #gscor - Structural correlation between two or more graphs. gscor<-function(dat,dat2=NULL,g1=NULL,g2=NULL,diag=FALSE,mode="digraph",method="anneal",reps=1000,prob.init=0.9,prob.decay=0.85,freeze.time=25,full.neighborhood=TRUE,exchange.list=0){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in gscor.") if(!is.null(dat2)){ dat2<-as.sociomatrix.sna(dat2) if(is.list(dat2)) stop("Identical graph orders required in gscor.") } #End pre-processing #Collect data and various parameters if(is.null(g1)) g1<-1:dim(dat)[1] if(is.null(g2)) g2<-1:dim(dat)[1] if(!is.null(dat2)){ if(length(dim(dat))>2) temp1<-dat else{ temp1<-array(dim=c(1,dim(dat)[2],dim(dat)[2])) temp1[1,,]<-dat } if(length(dim(dat2))>2) temp2<-dat2 else{ temp2<-array(dim=c(1,dim(dat2)[2],dim(dat2)[2])) temp2[1,,]<-dat2 } if(dim(temp1)[2]>dim(temp2)[2]) temp2<-add.isolates(temp2,dim(temp1)[2]-dim(temp2)[2]) if(dim(temp2)[2]>dim(temp1)[2]) temp1<-add.isolates(temp1,dim(temp2)[2]-dim(temp1)[2]) n<-dim(temp1)[2] gn<-dim(temp1)[1]+dim(temp2)[1] gn1<-dim(temp1)[1] gn2<-dim(temp2)[1] d<-array(dim=c(gn,n,n)) d[1:gn1,,]<-temp1 d[(gn1+1):(gn2+gn1),,]<-temp2 g1<-1:gn1 g2<-(gn1+1):(gn1+gn2) }else{ d<-dat n<-dim(dat)[2] gn<-dim(dat)[1] gn1<-length(g1) gn2<-length(g2) } #Scrap the diagonals, if required if(!diag) d<-diag.remove(d) #Now, get rid of the upper triangle if these are simple graphs if(mode=="graph") d<-upper.tri.remove(d) #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,gn*n),nrow=gn,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,gn) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Compute the structural correlation matrix gd<-matrix(nrow=gn1,ncol=gn2) rownames(gd)<-g1 colnames(gd)<-g2 if(method=="none"){ for(i in 1:gn1) for(j in 1:gn2){ d1<-d[g1[i],order(el[1,]),order(el[1,])] #Reorder d1 d2<-d[g2[j],order(el[2,]),order(el[2,])] #Reorder d2 if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") gd[i,j]<-cor(as.vector(d1),as.vector(d2),use="complete.obs") } }else if(method=="exhaustive"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.exhaustive(d[g1[i],,],d[g2[j],,],function(m1,m2){cor(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max") }else if(method=="anneal"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.anneal(d[g1[i],,],d[g2[j],,],function(m1,m2){cor(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max",prob.init=prob.init,prob.decay=prob.decay,freeze.time=freeze.time,full.neighborhood=full.neighborhood) }else if(method=="hillclimb"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.hillclimb(d[g1[i],,],d[g2[j],,],function(m1,m2){cor(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max") }else if(method=="mc"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.mc(d[g1[i],,],d[g2[j],,],function(m1,m2){cor(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max",draws=reps) } #If only one comparison requested, return as an element if((gn1==1)&(gn2==1)) gd[1,1] else gd } #gscov - Structural covariance between two or more graphs. gscov<-function(dat,dat2=NULL,g1=NULL,g2=NULL,diag=FALSE,mode="digraph",method="anneal",reps=1000,prob.init=0.9,prob.decay=0.85,freeze.time=25,full.neighborhood=TRUE,exchange.list=0){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in gscov.") if(!is.null(dat2)){ dat2<-as.sociomatrix.sna(dat2) if(is.list(dat2)) stop("Identical graph orders required in gscov.") } #End pre-processing #Collect data and various parameters if(is.null(g1)) g1<-1:dim(dat)[1] if(is.null(g2)) g2<-1:dim(dat)[1] if(!is.null(dat2)){ if(length(dim(dat))>2) temp1<-dat else{ temp1<-array(dim=c(1,dim(dat)[2],dim(dat)[2])) temp1[1,,]<-dat } if(length(dim(dat2))>2) temp2<-dat2 else{ temp2<-array(dim=c(1,dim(dat2)[2],dim(dat2)[2])) temp2[1,,]<-dat2 } if(dim(temp1)[2]>dim(temp2)[2]) temp2<-add.isolates(temp2,dim(temp1)[2]-dim(temp2)[2]) if(dim(temp2)[2]>dim(temp1)[2]) temp1<-add.isolates(temp1,dim(temp2)[2]-dim(temp1)[2]) n<-dim(temp1)[2] gn<-dim(temp1)[1]+dim(temp2)[1] gn1<-dim(temp1)[1] gn2<-dim(temp2)[1] d<-array(dim=c(gn,n,n)) d[1:gn1,,]<-temp1 d[(gn1+1):(gn2+gn1),,]<-temp2 g1<-1:gn1 g2<-(gn1+1):(gn1+gn2) }else{ d<-dat n<-dim(dat)[2] gn<-dim(dat)[1] gn1<-length(g1) gn2<-length(g2) } #Scrap the diagonals, if required if(!diag) d<-diag.remove(d) #Now, get rid of the upper triangle if these are simple graphs if(mode=="graph") d<-upper.tri.remove(d) #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,gn*n),nrow=gn,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,gn) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Compute the structural covariance matrix gd<-matrix(nrow=gn1,ncol=gn2) rownames(gd)<-g1 colnames(gd)<-g2 if(method=="none"){ for(i in 1:gn1) for(j in 1:gn2){ d1<-d[g1[i],order(el[1,]),order(el[1,])] #Reorder d1 d2<-d[g2[j],order(el[2,]),order(el[2,])] #Reorder d2 if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") gd[i,j]<-cov(as.vector(d1),as.vector(d2),use="complete.obs") } }else if(method=="exhaustive"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.exhaustive(d[g1[i],,],d[g2[j],,],function(m1,m2){cov(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max") }else if(method=="anneal"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.anneal(d[g1[i],,],d[g2[j],,],function(m1,m2){cov(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max",prob.init=prob.init,prob.decay=prob.decay,freeze.time=freeze.time,full.neighborhood=full.neighborhood) }else if(method=="hillclimb"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.hillclimb(d[g1[i],,],d[g2[j],,],function(m1,m2){cov(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max") }else if(method=="mc"){ for(i in 1:gn1) for(j in 1:gn2) gd[i,j]<-lab.optimize.mc(d[g1[i],,],d[g2[j],,],function(m1,m2){cov(as.vector(m1),as.vector(m2),use="complete.obs")},exchange.list=el[c(g1[i],g2[j]),],seek="max",draws=reps) } #If only one comparison requested, return as an element if((gn1==1)&(gn2==1)) gd[1,1] else gd } #hdist - Find the Hamming distances between two or more graphs. hdist<-function(dat,dat2=NULL,g1=NULL,g2=NULL,normalize=FALSE,diag=FALSE,mode="digraph"){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in hdist.") if(!is.null(dat2)){ dat2<-as.sociomatrix.sna(dat2) if(is.list(dat2)) stop("Identical graph orders required in hdist.") } #End pre-processing #Collect data and various parameters if(is.null(g1)) g1<-1:dim(dat)[1] if(is.null(g2)) g2<-1:dim(dat)[1] if(!is.null(dat2)){ if(length(dim(dat))>2) temp1<-dat else{ temp1<-array(dim=c(1,dim(dat)[2],dim(dat)[2])) temp1[1,,]<-dat } if(length(dim(dat2))>2) temp2<-dat2 else{ temp2<-array(dim=c(1,dim(dat2)[2],dim(dat2)[2])) temp2[1,,]<-dat2 } if(dim(temp1)[2]>dim(temp2)[2]) temp2<-add.isolates(temp2,dim(temp1)[2]-dim(temp2)[2]) if(dim(temp2)[2]>dim(temp1)[2]) temp1<-add.isolates(temp1,dim(temp2)[2]-dim(temp1)[2]) n<-dim(temp1)[2] gn<-dim(temp1)[1]+dim(temp2)[1] gn1<-dim(temp1)[1] gn2<-dim(temp2)[1] d<-array(dim=c(gn,n,n)) d[1:gn1,,]<-temp1 d[(gn1+1):(gn2+gn1),,]<-temp2 g1<-1:gn1 g2<-(gn1+1):(gn1+gn2) }else{ d<-dat n<-dim(dat)[2] gn<-dim(dat)[1] gn1<-length(g1) gn2<-length(g2) } #Scrap the diagonals, if required if(!diag) d<-diag.remove(d) #Now, get rid of the upper triangle if these are simple graphs if(mode=="graph") d<-upper.tri.remove(d) #Compute the raw distance matrix hd<-matrix(nrow=gn1,ncol=gn2) rownames(hd)<-g1 colnames(hd)<-g2 for(i in 1:gn1) for(j in 1:gn2) hd[i,j]<-sum(abs(d[g1[i],,]-d[g2[j],,]),na.rm=TRUE) #Normalize if need be if(normalize) hd<-hd/nties(dat[1,,],mode=mode,diag=diag) #If only one comparison requested, return as an element if((gn1==1)&(gn2==1)) hd[1,1] else hd } #sdmat - Estimate the matrix of structural distances among a set of unlabeled #graphs. #NOTE: This is redundant, as the included functionality is now included within #hdist and structdist, but the function is left for reasons of compatibility as #well as speed (currently, the distance functions don't check for duplicate #calculations when building distance matrices). sdmat<-function(dat,normalize=FALSE,diag=FALSE,mode="digraph",output="matrix",method="mc",exchange.list=NULL,...){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("Identical graph orders required in sdmat.") #End pre-processing if(is.null(exchange.list)) exchange.list<-rep(0,dim(dat)[2]) m<-dim(dat)[1] sdm<-matrix(nrow=m,ncol=m) for(i in 1:m) if(i # Last Modified 6/10/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains various routines for the calculation of # graph-level indices. # # Contents: # centralization # connectedness # dyad.census # efficiency # gden # grecip # gtrans # hierarchy # lubness # mutuality # triad.census # triad.classify # ###################################################################### #centralization - Find the centralization of a graph (for some arbitrary #centrality measure) centralization<-function(dat,FUN,g=NULL,mode="digraph",diag=FALSE,normalize=TRUE,...){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(mapply(centralization,dat[g],MoreArgs=list(FUN=FUN,g=1,mode=mode, diag=diag, normalize=normalize,...))) } #End pre-processing #Find the centrality function fun<-match.fun(FUN) #Grab the vector of centralities cv<-fun(dat,g=g,gmode=mode,diag=diag,...) #Find the empirical maximum cmax<-max(cv) #Now, for the absolute deviations.... cent<-sum(cmax-cv) #If we're normalizing, we'll need to get the theoretical max from our centrality function if(normalize) cent<-cent/fun(dat,g=g,gmode=mode,diag=diag,tmaxdev=TRUE,...) #Return the centralization cent } #connectedness - Find the Krackhardt connectedness of a graph or graph stack connectedness<-function(dat,g=NULL){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],connectedness)) } #End pre-processing g<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) n<-attr(g,"n") m<-NROW(g) if(n<=1) con<-1 else con<-.C("connectedness_R",as.double(g),as.integer(n),as.integer(m), con=as.double(0.0),PACKAGE="sna",NAOK=TRUE)$con #Return the result con } #dyad.census - Return the Holland and Leinhardt MAN dyad census for a given #graph or graph stack dyad.census<-function(dat,g=NULL){ #Define an internal function to get the dyad census for a single mat intcalc<-function(m){ n<-attr(m,"n") m<-m[m[,1]!=m[,2],,drop=FALSE] #Kill loops, if any if(NROW(m)>0){ dc<-.C("dyadcode_R",as.double(m),as.integer(n),as.integer(NROW(m)), dc=as.double(rep(0,NROW(m))),PACKAGE="sna",NAOK=TRUE)$dc mis<-is.na(m[,3]) #Count/remove missing dyads if(any(mis)){ mis[dc%in%c(dc[mis])]<-TRUE dcm<-dc[mis] dmut<-sum(duplicated(dcm)) dasym<-length(dcm)-2*dmut mc<-dmut+dasym dc<-dc[!mis] }else mc<-0 mut<-sum(duplicated(dc)) #Find non-missing counts asym<-length(dc)-2*mut c(mut,asym,choose(n,2)-mut-asym-mc) }else c(0,0,choose(n,2)) } #Organize the data dat<-as.edgelist.sna(dat) #Perform the census if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) man<-t(sapply(dat[g],intcalc)) }else{ man<-intcalc(dat) } if(length(man)==3) man<-matrix(man,nrow=1) colnames(man)<-c("Mut","Asym","Null") #Return the result man } #efficiency - Find the Krackhardt efficiency of a graph or graph stack efficiency<-function(dat,g=NULL,diag=FALSE){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],efficiency,diag=diag)) } #End pre-processing #Define an internal function, for convenience inteff<-function(g,diag){ comsz<-component.dist(g,connected="weak")$csize reqedge<-sum(comsz-1) #Get required edges maxv<-sum(comsz*(comsz-(!diag))-(comsz-1)) #Get maximum violations if(!diag) g<-diag.remove(g) edgec<-sum(g,na.rm=TRUE) #Get count of actual edges 1-(edgec-reqedge)/maxv } #Perform the actual calculation if(length(dim(dat))>2){ if(is.null(g)) g<-1:dim(dat)[1] eff<-apply(dat[g,,,drop=FALSE],1,inteff,diag=diag) }else eff<-inteff(dat,diag=diag) #Return the result eff } #gden - Compute the density of an input graph or graph stack. gden<-function(dat,g=NULL,diag=FALSE,mode="digraph",ignore.eval=FALSE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],gden,diag=diag,mode=mode,ignore.eval=ignore.eval)) } #End pre-processing n<-attr(dat,"n") bip<-attr(dat,"bipartite") #If needed, remove loops and missing edges if((!diag)&&(!(mode%in%c("hgraph","twomode")))) dat<-dat[dat[,1]!=dat[,2],,drop=FALSE] nmis<-sum(is.na(dat[,3])) dat<-dat[!is.na(dat[,3]),,drop=FALSE] #Find number/value of ties, and counts if(n==0){ den<-NaN }else if(n==1){ if(!diag) den<-NaN else{ if(ignore.eval) den<-(NROW(dat)>0)/(1-nmis) else den<-sum(dat[,3],na.rm=TRUE)/(1-nmis) } }else{ if(ignore.eval) count<-NROW(dat) else count<-sum(dat[,3]) nt<-switch(mode, digraph=n*(n-1)-nmis+diag*n, graph=n*(n-1)-nmis+diag*n, hgraph=bip*(n-bip)-nmis, twomode=bip*(n-bip)-nmis ) den<-count/nt } #Return the result den } #grecip - Compute the reciprocity of an input graph or graph stack. grecip<-function(dat,g=NULL,measure=c("dyadic","dyadic.nonnull","edgewise","edgewise.lrr","correlation")){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(!is.null(g)) dat<-dat[g] } #End pre-processing if(match.arg(measure)=="correlation"){ #Correlation measure if(!is.list(dat)) #For simplicity, coerce to list dat<-list(dat) recip<-sapply(dat,function(z){ #Compute the measure n<-attr(z,"n") #Get counts nd<-choose(n,2) ne<-nd*2 z<-z[z[,1]!=z[,2],,drop=FALSE] #Remove loops #Handle a zillion special cases if(n<2){ #Only defined if n>1 return(NA) }else if(n==2){ #No var for n=2, make 0/1 if(NROW(z)==0) return(1) else if(any(is.na(z[,3]))) return(NA) else if(NROW(z)==1){ if(z[1,3]!=0) return(0) else return(1) }else return((z[1,3]==z[2,3])+0) } #More general case if(NROW(z)>0){ #Process edges emiss<-sum(is.na(z[,3])) #Missing edge count gm<-sum(z[,3],na.rm=TRUE)/(ne-emiss) #Get graph mean and var gv<-(sum((z[,3]-gm)^2,na.rm=TRUE)+(ne-NROW(z))*gm^2)/(ne-emiss-1) if(gv==0) #If var 0, treat as corr 1 return(1) dc<-.C("dyadcode_R",as.double(z),as.integer(n),as.integer(NROW(z)), dc=as.double(rep(0,NROW(z))),PACKAGE="sna",NAOK=TRUE)$dc odc<-order(dc) zv<-z[odc,3]-gm #Order by dyad ID, subtract graph mean dc<-dc[odc] dsum<-0 #Compute the product-moment correlation dmiss<-0 dcount<-0 i<-1 while(i<=length(zv)){ if((i40000) FALSE else if((attr(z,"n")>1000)&&(NROW(z)/attr(z,"n")^2<0.5)) FALSE else TRUE }else if(inherits(z,"matrix")){ if(NCOL(z)>1000) FALSE else TRUE }else if(inherits(z,"array")){ if(dim(z)[2]>1000) FALSE else TRUE }else if(inherits(z,"network")){ if(network.size(z)>40000) FALSE else if((network.size(z)>1000)&& (network.edgecount(z)/network.size(z)^2<0.5)) FALSE else TRUE }else TRUE } if(is.list(dat)&&(!inherits(dat,"network"))) adjcheck<-sapply(dat,adjisok) else adjcheck<-adjisok(dat) if(any(!adjcheck)){ use.adjacency<-FALSE warning("gtrans called with use.adjacency=TRUE, but your data looks too large for that to work well. Overriding to edgelist method.") } } if(use.adjacency&&(match.arg(measure)=="rank")){ #Only edgelist for rank use.adjacency<-FALSE } #End crude triage if((!use.adjacency)&&(match.arg(measure)=="correlation")){ warning("Currently, non-adjacency computation for the correlation measure is not supported. Defaulting to use.adjacency==TRUE in gtrans.\n") use.adjacency<-TRUE } if(use.adjacency){ #Use adjacency matrix - much faster for n<1000 or dense #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],gtrans,diag=diag,mode=mode,measure=measure, use.adjacency=use.adjacency)) } #End pre-processing n<-dim(dat)[2] if(length(dim(dat))>2){ #Is this a stack? if(!is.null(g)){ #Were individual graphs selected? gn<-length(g) d<-dat[g,,] }else{ d<-dat gn<-dim(dat)[1] } }else{ d<-dat gn<-1 } if(gn==1){ #Only one graph - convert to stack format temp<-array(dim=c(1,n,n)) temp[1,,]<-d d<-temp } if(!diag) #If not using the diagonal, remove it d<-diag.remove(d,remove.val=0) #Compute the appropriate transitivity indices t<-vector() for(i in 1:gn){ #Prepare the transitivity test matrices if(match.arg(measure)!="correlation"){ dt<-d[i,,]!=0 }else{ dt<-d[i,,] } dsqt<-(dt%*%dt) #NA the diagonal, if needed if(!diag){ diag(dt)<-NA diag(dsqt)<-NA } #Compute the transitivity t[i]<-switch(match.arg(measure), strong=sum(dt*dsqt+(!dt)*(NCOL(d[i,,])-2-dsqt),na.rm=TRUE) / (choose(NCOL(d[i,,]),3)*6), strongcensus=sum(dt*dsqt+(!dt)*(NCOL(d[i,,])-2-dsqt),na.rm=TRUE), weak=sum(dt*dsqt,na.rm=TRUE)/sum(dsqt,na.rm=TRUE), weakcensus=sum(dt*dsqt,na.rm=TRUE), correlation=(function(x,y){ tv<-var(x,use="pairwise.complete.obs")* var(y,use="pairwise.complete.obs") if(is.na(tv)) NA else if(tv==0) all(x==y,na.rm=TRUE)+0 else cor(x,y,use="pairwise.complete.obs") })(x=as.vector(dt),y=as.vector(dsqt)) ) if(is.nan(t[i])) #By convention, map undefined case to 1 t[i]<-1 } #Return the result t }else{ #Use edgelist - much faster for large, sparse graphs #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],gtrans,diag=diag,mode=mode,measure=measure, use.adjacency=use.adjacency)) } #End pre-processing if(attr(dat,"n")<3) #Consider vacuously transitive if n<3 return(1) meas<-switch(match.arg(measure), "strong"=0, "strongcensus"=0, "weak"=1, "weakcensus"=1, "rank"=2, "correlation"=3 ) gt<-.C("transitivity_R",as.double(dat),as.integer(attr(dat,"n")), as.integer(NROW(dat)),gt=as.double(c(0,0)),as.integer(meas),as.integer(1),NAOK=TRUE,PACKAGE="sna")$gt if(match.arg(measure)%in%c("weak","strong","rank")){ if(gt[2]==0) #By convention, return 1 if no preconditions 1 else gt[1]/gt[2] }else gt[1] } } #hierarchy - Find the hierarchy score of a graph or graph stack hierarchy<-function(dat,g=NULL,measure=c("reciprocity","krackhardt")){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],hierarchy,measure=measure)) } #End pre-processing if(is.null(g)) g<-1:stackcount(dat) if(match.arg(measure)=="reciprocity") #Use reciprocity scores h<-1-grecip(dat,g) else if(match.arg(measure)=="krackhardt"){ #Calculate the Krackhardt reciprocity d<-array(dim=c(length(g),dim(dat)[2],dim(dat)[2])) if(length(dim(dat))>2) d<-dat[g,,,drop=FALSE] else d[1,,]<-dat h<-1-apply(d,1,function(x){r<-reachability(x); grecip(r,measure="dyadic.nonnull")}) } #Return the result h } #lubness - Find Krackhardt's Least Upper Boundedness of a graph or graph stack lubness<-function(dat,g=NULL){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)){ if(is.null(g)) g<-1:length(dat) return(sapply(dat[g],lubness)) } #End pre-processing #Define an internal function, for convenience intlub<-function(g){ r<-reachability(g) #Get reachability (in directed paths) of g cd<-component.dist(g,connected="weak") #Get weak components of g nolub<-0 maxnolub<-0 for(i in 1:max(cd$membership)){ #Walk through the components vi<-(1:dim(g)[1])[cd$membership==i] #Get the vertices of component i if(length(vi)>2){ #Components must be of size 3 #Accumulate violations viol<-as.double(0) viol<-.C("lubness_con_R",as.double(g[vi,vi]), as.double(length(vi)),as.integer(r[vi,vi]),viol=viol,PACKAGE="sna")$viol nolub<-nolub+viol #Also accumulate maximum violations maxnolub<-maxnolub+(length(vi)-1)*(length(vi)-2)/2 } } #Return 1-violations/max(violations) 1-nolub/maxnolub } #Perform the actual calculation if(length(dim(dat))>2){ if(!is.null(g)) dat<-dat[g,,,drop=FALSE] lub<-apply(dat,1,intlub) } else lub<-intlub(dat) #Return the result lub } #mutuality - Find the number of mutual (i.e., reciprocated) edges in a graph mutuality<-function(dat,g=NULL){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)){ if(!is.null(g)) dat<-dat[g] } #End pre-processing dc<-dyad.census(dat) #Obtain the dyad census for all specified graphs dc[,1] #Return the mutual count } #triad.census - Conduct a Davis and Leinhardt triad census for a graph or graph stack triad.census<-function(dat,g=NULL,mode=c("digraph","graph")){ #Pre-process the raw input dat<-as.edgelist.sna(dat) #End pre-processing #First, define the triad class vector tc<-switch(match.arg(mode), graph=0:3, digraph=c("003","012","102","021D","021U","021C","111D","111U","030T", "030C","201","120D","120U","120C","210","300") ) #Obtain triad census scores if(!is.list(dat)) dat<-list(dat) rnam<-names(dat) gm<-as.integer(switch(match.arg(mode),graph=0,digraph=1)) tcm<-matrix(nrow=length(dat),ncol=length(tc)) for(i in 1:length(dat)){ n<-as.integer(attr(dat[[i]],"n")) m<-as.integer(NROW(dat[[i]])) tcv<-as.double(rep(0,length(tc))) if(n>2) tcm[i,]<-.C("triad_census_R",as.double(dat[[i]]),n,m,tcv=tcv,gm, as.integer(1),PACKAGE="sna", NAOK=TRUE)$tcv } colnames(tcm)<-tc rownames(tcm)<-rnam #Return the result tcm } #triad.classify - Return the Davis and Leinhardt classification of a given triad triad.classify<-function(dat,g=1,tri=c(1,2,3),mode=c("digraph","graph")){ #Zeroth step: extract the triad dat<-as.sociomatrix.sna(dat) if(is.list(dat)) d<-dat[[g]][tri,tri] else if(length(dim(dat))==2) d<-dat[tri,tri] else d<-dat[g,tri,tri] #First, classify as NA if any entries are missing if(any(is.na(d[upper.tri(d)|lower.tri(d)]))) return(NA) #Next, define the triad class vector tc<-switch(match.arg(mode), graph=0:3, digraph=c("003","012","102","021D","021U","021C","111D","111U","030T", "030C","201","120D","120U","120C","210","300") ) #Classify the triad tt<-as.integer(0) gm<-as.integer(switch(match.arg(mode),graph=0,digraph=1)) tt<-.C("triad_classify_R",as.integer(d),tt=tt,gm,PACKAGE="sna")$tt tc[tt+1] } sna/R/models.R0000644000176200001440000033646114533477516012676 0ustar liggesusers###################################################################### # # models.R # # copyright (c) 2004, Carter T. Butts # Last Modified 7/18/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to stochastic models. # # Contents: # bbnam # bbnam.actor # bbnam.bf # bbnam.fixed # bbnam.jntlik # bbnam.jntlik.slice # bbnam.pooled # bn # bn.nlpl.dyad # bn.nlpl.edge # bn.nlpl.triad # bn.nltl # brokerage # coef.bn # coef.lnam # consensus # eval.edgeperturbation # lnam # nacf # netcancor # netlm # netlogit # npostpred # potscalered.mcmc # plot.bbnam # plot.bbnam.actor # plot.bbnam.fixed # plot.bbnam.pooled # plot.bn # plot.lnam # print.bbnam # print.bbnam.actor # print.bbnam.fixed # print.bbnam.pooled # print.bn # print.lnam # print.netcancor # print.netlm # print.netlogit # print.summary.bbnam # print.summary.bbnam.actor # print.summary.bbnam.fixed # print.summary.bbnam.pooled # print.summary.bn # print.summary.brokerage # print.summary.lnam # print.summary.netcancor # print.summary.netlm # print.summary.netlogit # pstar # se.lnam # summary.bbnam # summary.bbnam.actor # summary.bbnam.fixed # summary.bbnam.pooled # summary.bn # summary.brokerage # summary.lnam # summary.netcancor # summary.netlm # summary.netlogit # ###################################################################### #bbnam - Draw from Butts' Bayesian Network Accuracy Model. This version uses a #Gibbs' Sampler, and assumes error rates to be drawn from conditionally #independent betas for each actor. Note that dat MUST be an n x n x n array, #and that the data in question MUST be dichotomous. Priors are also assumed to #be in the right form (n x 2 matrices of alpha, beta pairs for em and ep, and #an n x n probability matrix for the network itself), and are not checked; #default behavior if no priors are provided is the uninformative case. #Wrapper function for the various bbnam models bbnam<-function(dat,model="actor",...){ if(model=="actor") bbnam.actor(dat,...) else if(model=="pooled") bbnam.pooled(dat,...) else if(model=="fixed") bbnam.fixed(dat,...) } #bbnam.actor - Draw from the error-prob-by-actor model bbnam.actor<-function(dat,nprior=0.5,emprior=c(1,11),epprior=c(1,11),diag=FALSE, mode="digraph",reps=5,draws=1500,burntime=500,quiet=TRUE,anames=NULL,onames=NULL,compute.sqrtrhat=TRUE){ dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("All bbnam input graphs must be of the same order.") if(length(dim(dat))==2) dat<-array(dat,dim=c(1,NROW(dat),NCOL(dat))) #First, collect some basic model parameters and do other "setup" stuff if(reps==1) compute.sqrtrhat<-FALSE #Can't use Rhat if we have only one chain! m<-dim(dat)[1] n<-dim(dat)[2] d<-dat slen<-burntime+floor(draws/reps) out<-list() if((!is.matrix(nprior))||(NROW(nprior)!=n)||(NCOL(nprior)!=n)) nprior<-matrix(nprior,n,n) if((!is.matrix(emprior))||(NROW(emprior)!=m)||(NCOL(emprior)!=2)){ if(length(emprior)==2) emprior<-sapply(emprior,rep,m) else emprior<-matrix(emprior,m,2) } if((!is.matrix(epprior))||(NROW(epprior)!=m)||(NCOL(epprior)!=2)){ if(length(epprior)==2) epprior<-sapply(epprior,rep,m) else epprior<-matrix(epprior,m,2) } if(is.null(anames)) anames<-paste("a",1:n,sep="") if(is.null(onames)) onames<-paste("o",1:m,sep="") #Remove any data which doesn't count... if(mode=="graph") d<-upper.tri.remove(d) if(!diag) d<-diag.remove(d) #OK, let's get started. First, create temp variables to hold draws, and draw #initial conditions for the Markov chain if(!quiet) cat("Creating temporary variables and drawing initial conditions....\n") a<-array(dim=c(reps,slen,n,n)) em<-array(dim=c(reps,slen,m)) ep<-array(dim=c(reps,slen,m)) for(k in 1:reps){ a[k,1,,]<-rgraph(n,1,diag=diag,mode=mode) em[k,1,]<-runif(m,0,0.5) ep[k,1,]<-runif(m,0,0.5) } #Let the games begin: draw from the Gibbs' sampler for(i in 1:reps){ for(j in 2:slen){ if(!quiet) cat("Repetition",i,", draw",j,":\n\tDrawing adjacency matrix\n") #Create tie probability matrix ep.a<-aperm(array(sapply(ep[i,j-1,],rep,n^2),dim=c(n,n,m)),c(3,2,1)) em.a<-aperm(array(sapply(em[i,j-1,],rep,n^2),dim=c(n,n,m)),c(3,2,1)) pygt<-apply(d*(1-em.a)+(1-d)*em.a,c(2,3),prod,na.rm=TRUE) pygnt<-apply(d*ep.a+(1-d)*(1-ep.a),c(2,3),prod,na.rm=TRUE) tieprob<-(nprior*pygt)/(nprior*pygt+(1-nprior)*pygnt) if(mode=="graph") tieprob[upper.tri(tieprob)]<-t(tieprob)[upper.tri(tieprob)] #Draw Bernoulli graph a[i,j,,]<-rgraph(n,1,tprob=tieprob,mode=mode,diag=diag) if(!quiet) cat("\tAggregating binomial counts\n") cem<-matrix(nrow=m,ncol=2) cep<-matrix(nrow=m,ncol=2) for(x in 1:m){ cem[x,1]<-sum((1-d[x,,])*a[i,j,,],na.rm=TRUE) cem[x,2]<-sum(d[x,,]*a[i,j,,],na.rm=TRUE) cep[x,1]<-sum(d[x,,]*(1-a[i,j,,]),na.rm=TRUE) cep[x,2]<-sum((1-d[x,,])*(1-a[i,j,,]),na.rm=TRUE) } if(!quiet) cat("\tDrawing error parameters\n") em[i,j,]<-rbeta(m,emprior[,1]+cem[,1],emprior[,2]+cem[,2]) ep[i,j,]<-rbeta(m,epprior[,1]+cep[,1],epprior[,2]+cep[,2]) } } if(!quiet) cat("Finished drawing from Markov chain. Now computing potential scale reduction statistics.\n") if(compute.sqrtrhat){ out$sqrtrhat<-vector() for(i in 1:n) for(j in 1:n) out$sqrtrhat<-c(out$sqrtrhat,potscalered.mcmc(aperm(a,c(2,1,3,4))[,,i,j])) for(i in 1:m) out$sqrtrhat<-c(out$sqrtrhat,potscalered.mcmc(aperm(em,c(2,1,3))[,,i]),potscalered.mcmc(aperm(ep,c(2,1,3))[,,i])) if(!quiet) cat("\tMax potential scale reduction (Gelman et al.'s sqrt(Rhat)) for all scalar estimands:",max(out$sqrtrhat[!is.nan(out$sqrtrhat)],na.rm=TRUE),"\n") } if(!quiet) cat("Preparing output.\n") #Whew, we're done with the MCMC. Now, let's get that data together. out$net<-array(dim=c(reps*(slen-burntime),n,n)) for(i in 1:reps) for(j in burntime:slen){ out$net[(i-1)*(slen-burntime)+(j-burntime),,]<-a[i,j,,] } if(!quiet) cat("\tAggregated network variable draws\n") out$em<-em[1,(burntime+1):slen,] out$ep<-ep[1,(burntime+1):slen,] if(reps>=2) for(i in 2:reps){ out$em<-rbind(out$em,em[i,(burntime+1):slen,]) out$ep<-rbind(out$ep,ep[i,(burntime+1):slen,]) } if(!quiet) cat("\tAggregated error parameters\n") #Finish off the output and return it. out$anames<-anames out$onames<-onames out$nactors<-n out$nobservers<-m out$reps<-reps out$draws<-dim(out$em)[1] out$burntime<-burntime out$model<-"actor" class(out)<-c("bbnam.actor","bbnam") out } #bbnam.bf - Estimate Bayes Factors for the Butts Bayesian Network Accuracy #Model. This implementation relies on monte carlo integration to estimate the #BFs, and tests the fixed probability, pooled, and pooled by actor models. bbnam.bf<-function(dat,nprior=0.5,em.fp=0.5,ep.fp=0.5,emprior.pooled=c(1,11),epprior.pooled=c(1,11),emprior.actor=c(1,11),epprior.actor=c(1,11),diag=FALSE, mode="digraph",reps=1000){ dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("All bbnam.bf input graphs must be of the same order.") if(length(dim(dat))==2) dat<-array(dat,dim=c(1,NROW(dat),NCOL(dat))) m<-dim(dat)[1] n<-dim(dat)[2] if((!is.matrix(nprior))||(NROW(nprior)!=n)||(NCOL(nprior)!=n)) nprior<-matrix(nprior,n,n) if((!is.matrix(emprior.actor))||(NROW(emprior.actor)!=m)|| (NCOL(emprior.actor)!=2)){ if(length(emprior.actor)==2) emprior.actor<-sapply(emprior.actor,rep,m) else emprior.actor<-matrix(emprior.actor,m,2) } if((!is.matrix(epprior.actor))||(NROW(epprior.actor)!=m)|| (NCOL(epprior.actor)!=2)){ if(length(epprior.actor)==2) epprior.actor<-sapply(epprior.actor,rep,m) else epprior.actor<-matrix(epprior.actor,m,2) } d<-dat if(!diag) d<-diag.remove(d) if(mode=="graph") d<-lower.tri.remove(d) pfpv<-vector() ppov<-vector() pacv<-vector() #Draw em, ep, and a values for the various models for(i in 1:reps){ a<-rgraph(n,1,tprob=nprior) em.pooled<-eval(call("rbeta",1,emprior.pooled[1],emprior.pooled[2])) ep.pooled<-eval(call("rbeta",1,epprior.pooled[1],epprior.pooled[2])) em.actor<-eval(call("rbeta",n,emprior.actor[,1],emprior.actor[,2])) ep.actor<-eval(call("rbeta",n,epprior.actor[,1],epprior.actor[,2])) pfpv[i]<-bbnam.jntlik(d,a=a,em=em.fp,ep=ep.fp,log=TRUE) ppov[i]<-bbnam.jntlik(d,a=a,em=em.pooled,ep=ep.pooled,log=TRUE) pacv[i]<-bbnam.jntlik(d,a=a,em=em.actor,ep=ep.actor,log=TRUE) } int.lik<-c(logMean(pfpv),logMean(ppov),logMean(pacv)) int.lik.std<-sqrt(c(var(pfpv),var(ppov),var(pacv))) int.lik.std<-(logSub(c(logMean(2*pfpv),logMean(2*ppov),logMean(2*pacv)), 2*int.lik)-log(reps))/2 #Find the Bayes Factors o<-list() o$int.lik<-matrix(nrow=3,ncol=3) for(i in 1:3) for(j in 1:3){ if(i!=j) o$int.lik[i,j]<-int.lik[i]-int.lik[j] else o$int.lik[i,i]<-int.lik[i] } o$int.lik.std<-int.lik.std o$reps<-reps o$prior.param<-list(nprior,em.fp,ep.fp,emprior.pooled,epprior.pooled,emprior.actor,epprior.actor) o$prior.param.names<-c("nprior","em.fp","ep.fp","emprior.pooled","epprior.pooled","emprior.actor","epprior.actor") o$model.names<-c("Fixed Error Prob","Pooled Error Prob","Actor Error Prob") class(o)<-c("bbnam.bf","bayes.factor") o } #bbnam.fixed - Draw from the fixed probability error model bbnam.fixed<-function(dat,nprior=0.5,em=0.25,ep=0.25,diag=FALSE,mode="digraph",draws=1500,outmode="draws",anames=NULL,onames=NULL){ dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("All bbnam input graphs must be of the same order.") if(length(dim(dat))==2) dat<-array(dat,dim=c(1,NROW(dat),NCOL(dat))) #How many actors are involved? m<-dim(dat)[1] n<-dim(dat)[2] if((!is.matrix(nprior))||(NROW(nprior)!=n)||(NCOL(nprior)!=n)) nprior<-matrix(nprior,n,n) if(is.null(anames)) anames<-paste("a",1:n,sep="") if(is.null(onames)) onames<-paste("o",1:m,sep="") #Check to see if we've been given full matrices (or vectors) of error probs... if(length(em)==m*n^2) em.a<-em else if(length(em)==n^2) em.a<-apply(em,c(1,2),rep,m) else if(length(em)==m) em.a<-aperm(array(sapply(em,rep,n^2),dim=c(n,n,m)),c(3,2,1)) else if(length(em)==1) em.a<-array(rep(em,m*n^2),dim=c(m,n,n)) if(length(ep)==m*n^2) ep.a<-ep else if(length(ep)==n^2) ep.a<-apply(ep,c(1,2),rep,m) else if(length(ep)==m) ep.a<-aperm(array(sapply(ep,rep,n^2),dim=c(n,n,m)),c(3,2,1)) else if(length(ep)==1) ep.a<-array(rep(ep,m*n^2),dim=c(m,n,n)) #Find the network posterior pygt<-apply(dat*(1-em.a)+(1-dat)*em.a,c(2,3),prod,na.rm=TRUE) pygnt<-apply(dat*ep.a+(1-dat)*(1-ep.a),c(2,3),prod,na.rm=TRUE) npost<-(nprior*pygt)/(nprior*pygt+(1-nprior)*pygnt) #Send the needed output if(outmode=="posterior") npost else{ o<-list() o$net<-rgraph(n,draws,tprob=npost,diag=diag,mode=mode) o$anames<-anames o$onames<-onames o$nactors<-n o$nobservers<-m o$draws<-draws o$model<-"fixed" class(o)<-c("bbnam.fixed","bbnam") o } } #bbnam.jntlik - An internal function for bbnam bbnam.jntlik<-function(dat,log=FALSE,...){ p<-sum(sapply(1:dim(dat)[1],bbnam.jntlik.slice,dat=dat,log=TRUE,...)) if(!log) exp(p) else p } #bbnam.jntlik.slice - An internal function for bbnam bbnam.jntlik.slice<-function(s,dat,a,em,ep,log=FALSE){ if(length(em)>1) em.l<-em[s] else em.l<-em if(length(ep)>1) ep.l<-ep[s] else ep.l<-ep p<-sum(log((1-a)*(dat[s,,]*ep.l+(1-dat[s,,])*(1-ep.l))+a*(dat[s,,]*(1-em.l)+(1-dat[s,,])*em.l)),na.rm=TRUE) if(!log) exp(p) else p } #bbnam.pooled - Draw from the pooled error model bbnam.pooled<-function(dat,nprior=0.5,emprior=c(1,11),epprior=c(1,11), diag=FALSE,mode="digraph",reps=5,draws=1500,burntime=500,quiet=TRUE,anames=NULL,onames=NULL,compute.sqrtrhat=TRUE){ dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("All bbnam input graphs must be of the same order.") if(length(dim(dat))==2) dat<-array(dat,dim=c(1,NROW(dat),NCOL(dat))) #First, collect some basic model parameters and do other "setup" stuff if(reps==1) compute.sqrtrhat<-FALSE #Can't use Rhat if we have only one chain! m<-dim(dat)[1] n<-dim(dat)[2] d<-dat slen<-burntime+floor(draws/reps) out<-list() if((!is.matrix(nprior))||(NROW(nprior)!=n)||(NCOL(nprior)!=n)) nprior<-matrix(nprior,n,n) if(is.null(anames)) anames<-paste("a",1:n,sep="") if(is.null(onames)) onames<-paste("o",1:m,sep="") #Remove any data which doesn't count... if(mode=="graph") d<-upper.tri.remove(d) if(!diag) d<-diag.remove(d) #OK, let's get started. First, create temp variables to hold draws, and draw #initial conditions for the Markov chain if(!quiet) cat("Creating temporary variables and drawing initial conditions....\n") a<-array(dim=c(reps,slen,n,n)) em<-array(dim=c(reps,slen)) ep<-array(dim=c(reps,slen)) for(k in 1:reps){ a[k,1,,]<-rgraph(n,1,diag=diag,mode=mode) em[k,1]<-runif(1,0,0.5) ep[k,1]<-runif(1,0,0.5) } #Let the games begin: draw from the Gibbs' sampler for(i in 1:reps){ for(j in 2:slen){ if(!quiet) cat("Repetition",i,", draw",j,":\n\tDrawing adjacency matrix\n") #Create tie probability matrix ep.a<-array(rep(ep[i,j-1],m*n^2),dim=c(m,n,n)) em.a<-array(rep(em[i,j-1],m*n^2),dim=c(m,n,n)) pygt<-apply(d*(1-em.a)+(1-d)*em.a,c(2,3),prod,na.rm=TRUE) pygnt<-apply(d*ep.a+(1-d)*(1-ep.a),c(2,3),prod,na.rm=TRUE) tieprob<-(nprior*pygt)/(nprior*pygt+(1-nprior)*pygnt) if(mode=="graph") tieprob[upper.tri(tieprob)]<-t(tieprob)[upper.tri(tieprob)] #Draw Bernoulli graph a[i,j,,]<-rgraph(n,1,tprob=tieprob,mode=mode,diag=diag) if(!quiet) cat("\tAggregating binomial counts\n") cem<-vector(length=2) cep<-vector(length=2) a.a<-apply(a[i,j,,],c(1,2),rep,m) cem[1]<-sum((1-d)*a.a,na.rm=TRUE) cem[2]<-sum(d*a.a,na.rm=TRUE) cep[1]<-sum(d*(1-a.a),na.rm=TRUE) cep[2]<-sum((1-d)*(1-a.a),na.rm=TRUE) #cat("em - alpha",cem[1],"beta",cem[2]," ep - alpha",cep[1],"beta",cep[2],"\n") if(!quiet) cat("\tDrawing error parameters\n") em[i,j]<-rbeta(1,emprior[1]+cem[1],emprior[2]+cem[2]) ep[i,j]<-rbeta(1,epprior[1]+cep[1],epprior[2]+cep[2]) } } if(!quiet) cat("Finished drawing from Markov chain. Now computing potential scale reduction statistics.\n") if(compute.sqrtrhat){ out$sqrtrhat<-vector() for(i in 1:n) for(j in 1:n) out$sqrtrhat<-c(out$sqrtrhat,potscalered.mcmc(aperm(a,c(2,1,3,4))[,,i,j])) out$sqrtrhat<-c(out$sqrtrhat,potscalered.mcmc(em),potscalered.mcmc(ep)) if(!quiet) cat("\tMax potential scale reduction (Gelman et al.'s sqrt(Rhat)) for all scalar estimands:",max(out$sqrtrhat[!is.nan(out$sqrtrhat)],na.rm=TRUE),"\n") } if(!quiet) cat("Preparing output.\n") #Whew, we're done with the MCMC. Now, let's get that data together. out$net<-array(dim=c(reps*(slen-burntime),n,n)) for(i in 1:reps) for(j in burntime:slen){ out$net[(i-1)*(slen-burntime)+(j-burntime),,]<-a[i,j,,] } if(!quiet) cat("\tAggregated network variable draws\n") out$em<-em[1,(burntime+1):slen] out$ep<-ep[1,(burntime+1):slen] if(reps>=2) for(i in 2:reps){ out$em<-c(out$em,em[i,(burntime+1):slen]) out$ep<-c(out$ep,ep[i,(burntime+1):slen]) } if(!quiet) cat("\tAggregated error parameters\n") #Finish off the output and return it. out$anames<-anames out$onames<-onames out$nactors<-n out$nobservers<-m out$reps<-reps out$draws<-length(out$em) out$burntime<-burntime out$model<-"pooled" class(out)<-c("bbnam.pooled","bbnam") out } #bbnam.probtie - Probability of a given tie bbnam.probtie<-function(dat,i,j,npriorij,em,ep){ num<-npriorij denom<-1-npriorij num<-num*prod(dat[,i,j]*(1-em)+(1-dat[,i,j])*em,na.rm=TRUE) denom<-denom*prod(dat[,i,j]*ep+(1-dat[,i,j])*(1-ep),na.rm=TRUE) p<-num/(denom+num) p } #bn - Fit a biased net model bn<-function(dat,method=c("mple.triad","mple.dyad","mple.edge","mtle"),param.seed=NULL,param.fixed=NULL,optim.method="BFGS",optim.control=list(),epsilon=1e-5){ dat<-as.sociomatrix.sna(dat,simplify=FALSE) if(is.list(dat)) return(lapply(dat,bn,method=method,param.seed=param.seed, param.fixed=param.fixed,optim.method=optim.method,optim.contol=optim.control,epsilon=epsilon)) else if(length(dim(dat))>2) return(apply(dat,1,bn,method=method,param.seed=param.seed, param.fixed=param.fixed,optim.method=optim.method,optim.contol=optim.control,epsilon=epsilon)) n<-NROW(dat) #Make sure dat is appropriate if(!is.matrix(dat)) stop("Adjacency matrix required in bn.") dat<-dat>0 #Choose the objective function to use nll<-switch(match.arg(method), mple.edge=match.fun("bn.nlpl.edge"), mple.dyad=match.fun("bn.nlpl.dyad"), mple.triad=match.fun("bn.nlpl.triad"), mtle=match.fun("bn.nltl") ) #Extract the necessary sufficient statistics if(match.arg(method)%in%c("mple.edge","mple.dyad")){ #Use dyad census stats stats<-matrix(0,nrow=n-1,ncol=4) stats<-matrix(.C("bn_dyadstats_R",as.integer(dat),as.double(n), stats=as.double(stats),PACKAGE="sna")$stats,ncol=4) stats<-stats[apply(stats[,2:4],1,sum)>0,] #Strip uneeded rows }else if(match.arg(method)=="mple.triad"){ #Use full dyad stats stats<-matrix(0,nrow=n,ncol=n) stats<-matrix(.C("bn_triadstats_R",as.integer(dat),as.double(n), stats=as.double(stats),PACKAGE="sna")$stats,nrow=n,ncol=n) }else if(match.arg(method)=="mtle"){ #Use triad census stats stats<-as.vector(triad.census(dat)) #Obtain triad census } #Initialize parameters (using crudely reasonable values) if(is.null(param.seed)) param<-c(gden(dat),grecip(dat,measure="edgewise"),gtrans(dat),gtrans(dat)) else{ param<-c(gden(dat),grecip(dat,measure="edgewise"),gtrans(dat),gtrans(dat)) if(!is.null(param.seed$pi)) param[1]<-param.seed$pi if(!is.null(param.seed$sigma)) param[2]<-param.seed$sigma if(!is.null(param.seed$rho)) param[3]<-param.seed$rho if(!is.null(param.seed$d)) param[4]<-param.seed$d } if(is.null(param.fixed)) #Do we need to fix certain parameter values? fixed<-rep(NA,4) else{ fixed<-rep(NA,4) if(!is.null(param.fixed$pi)) fixed[1]<-param.fixed$pi if(!is.null(param.fixed$sigma)) fixed[2]<-param.fixed$sigma if(!is.null(param.fixed$rho)) fixed[3]<-param.fixed$rho if(!is.null(param.fixed$d)) fixed[4]<-param.fixed$d } param<-pmax(pmin(param,1-epsilon),epsilon) #Ensure interior starting vals param<-log(param/(1-param)) #Transform to logit scale #Fit the model fit<-optim(param,nll,method=optim.method,control=optim.control,stats=stats, fixed=fixed,dat=dat) fit$par<-1/(1+exp(-fit$par)) #Untransform fit$par[!is.na(fixed)]<-fixed[!is.na(fixed)] #Fix #Prepare the results out<-list(d=fit$par[4],pi=fit$par[1],sigma=fit$par[2],rho=fit$par[3], method=match.arg(method),G.square=2*fit$value,epsilon=epsilon) #Add GOF for triads if(match.arg(method)=="mtle") out$triads<-stats else out$triads<-as.vector(triad.census(dat)) out$triads.pred<-.C("bn_ptriad_R", as.double(out$pi),as.double(out$sigma),as.double(out$rho), as.double(out$d),pt=as.double(rep(0,16)),PACKAGE="sna")$pt names(out$triads.pred)<-c("003", "012", "102", "021D", "021U", "021C", "111D", "111U", "030T", "030C", "201", "120D", "120U", "120C", "210", "300") names(out$triads)<-names(out$triads.pred) #Add GOF for dyads, using triad distribution if(match.arg(method)%in%c("mple.edge","mple.dyad")) out$dyads<-apply(stats[,-1],2,sum) else out$dyads<-as.vector(dyad.census(dat)) out$dyads.pred<-c(sum(out$triads.pred*c(0,0,1,0,0,0,1,1,0,0,2,1,1,1,2,3)), sum(out$triads.pred*c(0,1,0,2,2,2,1,1,3,3,0,2,2,2,1,0)), sum(out$triads.pred*c(3,2,2,1,1,1,1,1,0,0,1,0,0,0,0,0)))*choose(n,3)/choose(n,2)/(n-2) names(out$dyads.pred)<-c("Mut","Asym","Null") names(out$dyads)<-names(out$dyads.pred) #Add GOF for edges, using dyad distribution out$edges<-c(2*out$dyads[1]+out$dyads[2],2*out$dyads[3]+out$dyads[2]) out$edges.pred<-c(2*out$dyads.pred[1]+out$dyads.pred[2], 2*out$dyads.pred[3]+out$dyads.pred[2])/2 names(out$edges.pred)<-c("Present","Absent") names(out$edges)<-names(out$edges.pred) #Add predicted structure statistics (crude) a<-out$d*(n-1) out$ss.pred<-c(1/n,(1-1/n)*(1-exp(-a/n))) for(i in 2:(n-1)) out$ss.pred<-c(out$ss.pred,(1-sum(out$ss.pred[1:i])) * (1-exp(-(a-out$pi-out$sigma*(a-1))*out$ss.pred[i]))) out$ss.pred<-cumsum(out$ss.pred) names(out$ss.pred)<-0:(n-1) out$ss<-structure.statistics(dat) #Return the result class(out)<-"bn" out } #bn.nlpl.dyad - Compute the dyadic -log pseudolikelihood for a biased net model bn.nlpl.dyad<-function(p,stats,fixed=rep(NA,4),...){ p<-1/(1+exp(-p)) #Correct for any fixed parameters p[!is.na(fixed)]<-fixed[!is.na(fixed)] #Calculate the pseudolikelihood lpl<-0 lpl<-.C("bn_lpl_dyad_R",as.double(stats),as.double(NROW(stats)), as.double(p[1]),as.double(p[2]),as.double(p[3]),as.double(p[4]), lpl=as.double(lpl),PACKAGE="sna")$lpl -lpl } #bn.nlpl.edge - Compute the -log pseudolikelihood for a biased net model, #using the directed edge pseudolikelihood. Not sure why you'd want to #do this, except as a check on the other results.... bn.nlpl.edge<-function(p,stats,fixed=rep(NA,4),...){ p<-1/(1+exp(-p)) #Correct for any fixed parameters p[!is.na(fixed)]<-fixed[!is.na(fixed)] #Calculate the pseudolikelihood lp<-cbind(1-(1-p[1])*((1-p[3])^stats[,1])*((1-p[2])^stats[,1])*(1-p[4]), 1-((1-p[2])^stats[,1])*(1-p[4])) lp<-log(cbind(lp,1-lp)) lpl<-cbind(2*stats[,2]*lp[,1],stats[,3]*lp[,2],stats[,3]*lp[,3], 2*stats[,4]*lp[,4]) lpl[is.nan(lpl)]<-0 #Treat 0 * -Inf as 0 -sum(lpl) } #bn.nlpl.triad - Compute the triadic -log pseudolikelihood for a biased net #model, using the Skvoretz (2003) working paper method bn.nlpl.triad<-function(p,dat,stats,fixed=rep(NA,4),...){ p<-1/(1+exp(-p)) #Correct for any fixed parameters p[!is.na(fixed)]<-fixed[!is.na(fixed)] #Calculate the pseudolikelihood lpl<-0 lpl<-.C("bn_lpl_triad_R",as.integer(dat),as.double(stats), as.double(NROW(stats)),as.double(p[1]),as.double(p[2]),as.double(p[3]), as.double(p[4]), lpl=as.double(lpl),PACKAGE="sna")$lpl -lpl } #bn.nltl - Compute the -log triad likelihood for a biased net model bn.nltl<-function(p,stats,fixed=rep(NA,4),...){ p<-1/(1+exp(-p)) #Correct for any fixed parameters p[!is.na(fixed)]<-fixed[!is.na(fixed)] #Calculate the triad likelihood pt<-rep(0,16) triprob<-.C("bn_ptriad_R", as.double(p[1]),as.double(p[2]),as.double(p[3]), as.double(p[4]),pt=as.double(pt),PACKAGE="sna")$pt -sum(stats*log(triprob)) } #brokerage - perform a Gould-Fernandez brokerage analysis brokerage<-function(g,cl){ #Pre-process the raw input g<-as.edgelist.sna(g) if(is.list(g)) return(lapply(g,brokerage,cl)) #End pre-processing N<-attr(g,"n") m<-NROW(g) classes<-unique(cl) icl<-match(cl,classes) #Compute individual brokerage measures br<-matrix(0,N,5) br<-matrix(.C("brokerage_R",as.double(g),as.integer(N),as.integer(m), as.integer(icl), brok=as.double(br),PACKAGE="sna",NAOK=TRUE)$brok,N,5) br<-cbind(br,apply(br,1,sum)) #Global brokerage measures gbr<-apply(br,2,sum) #Calculate expectations and such d<-m/(N*(N-1)) clid<-unique(cl) #Count the class memberships n<-vector() for(i in clid) n<-c(n,sum(cl==i)) n<-as.double(n) #This shouldn't be needed, but R will generate N<-as.double(N) #integer overflows unless we coerce to double! ebr<-matrix(0,length(clid),6) vbr<-matrix(0,length(clid),6) for(i in 1:length(clid)){ #Compute moments by broker's class #Type 1: Within-group (wI) ebr[i,1]<-d^2*(1-d)*(n[i]-1)*(n[i]-2) vbr[i,1]<-ebr[i,1]*(1-d^2*(1-d))+2*(n[i]-1)*(n[i]-2)*(n[i]-3)*d^3*(1-d)^3 #Type 2: Itinerant (WO) ebr[i,2]<-d^2*(1-d)*sum(n[-i]*(n[-i]-1)) vbr[i,2]<-ebr[i,2]*(1-d^2*(1-d))+ 2*sum(n[-i]*(n[-i]-1)*(n[-i]-2))*d^3*(1-d)^3 #Type 3: Representative (bIO) ebr[i,3]<-d^2*(1-d)*(N-n[i])*(n[i]-1) vbr[i,3]<-ebr[i,3]*(1-d^2*(1-d))+ 2*((n[i]-1)*choose(N-n[i],2)+(N-n[i])*choose(n[i]-1,2))*d^3*(1-d)^3 #Type 4: Gatekeeping (bOI) ebr[i,4]<-ebr[i,3] vbr[i,4]<-vbr[i,3] #Type 5: Liason (bO) ebr[i,5]<-d^2*(1-d)*(sum((n[-i])%o%(n[-i]))-sum(n[-i]^2)) vbr[i,5]<-ebr[i,5]*(1-d^2*(1-d))+ 4*sum(n[-i]*choose(N-n[-i]-n[i],2)*d^3*(1-d)^3) #Total ebr[i,6]<-d^2*(1-d)*(N-1)*(N-2) vbr[i,6]<-ebr[i,6]*(1-d^2*(1-d))+2*(N-1)*(N-2)*(N-3)*d^3*(1-d)^3 } br.exp<-vector() br.sd<-vector() for(i in 1:N){ temp<-match(cl[i],clid) br.exp<-rbind(br.exp,ebr[temp,]) br.sd<-rbind(br.sd,sqrt(vbr[temp,])) } br.z<-(br-br.exp)/br.sd egbr<-vector() #Global expections/variances vgbr<-vector() #Type 1: Within-group (wI) egbr[1]<-d^2*(1-d)*sum(n*(n-1)*(n-2)) vgbr[1]<-egbr[1]*(1-d^2*(1-d))+ sum(n*(n-1)*(n-2)*(((4*n-10)*d^3*(1-d)^3)-(4*(n-3)*d^4*(1-d)^2)+((n-3)*d^5*(1-d)))) #Type 2: Itinerant (WO) egbr[2]<-d^2*(1-d)*sum(n*(N-n)*(n-1)) vgbr[2]<-egbr[2]*(1-d^2*(1-d))+ (sum(outer(n,n,function(x,y){x*y*(x-1)*(((2*x+2*y-6)*d^3*(1-d)^3)+((N-x-1)*d^5*(1-d)))})) - sum(n*n*(n-1)*(((4*n-6)*d^3*(1-d)^3)+((N-n-1)*d^5*(1-d))))) #Type 3: Representative (bIO) egbr[3]<-d^2*(1-d)*sum(n*(N-n)*(n-1)) vgbr[3]<-egbr[3]*(1-d^2*(1-d))+ sum(n*(N-n)*(n-1)*(((N-3)*d^3*(1-d)^3)+((n-2)*d^5*(1-d)))) #Type 4: Gatekeeping (bOI) egbr[4]<-egbr[3] vgbr[4]<-vgbr[3] #Type 5: Liason (bO) egbr[5]<- d^2*(1-d)*(sum(outer(n,n,function(x,y){x*y*(N-x-y)}))-sum(n*n*(N-2*n))) vgbr[5]<-egbr[5]*(1-d^2*(1-d)) for(i in 1:length(n)) for(j in 1:length(n)) for(k in 1:length(n)) if((i!=j)&&(j!=k)&&(i!=k)) vgbr[5]<-vgbr[5] + n[i]*n[j]*n[k] * ((4*(N-n[j])-2*(n[i]+n[k]+1))*d^3*(1-d)^3-(4*(N-n[k])-2*(n[i]+n[j]+1))*d^4*(1-d)^2+(N-(n[i]+n[k]+1))*d^5*(1-d)) #Total egbr[6]<-d^2*(1-d)*N*(N-1)*(N-2) vgbr[6]<-egbr[6]*(1-d^2*(1-d))+ N*(N-1)*(N-2)*(((4*N-10)*d^3*(1-d)^3)-(4*(N-3)*d^4*(1-d)^2)+((N-3)*d^5*(1-d))) #Return the results br.nam<-c("w_I","w_O","b_IO","b_OI","b_O","t") colnames(br)<-br.nam rownames(br)<-attr(g,"vnames") colnames(br.exp)<-br.nam rownames(br.exp)<-attr(g,"vnames") colnames(br.sd)<-br.nam rownames(br.sd)<-attr(g,"vnames") colnames(br.z)<-br.nam rownames(br.z)<-attr(g,"vnames") names(gbr)<-br.nam names(egbr)<-br.nam names(vgbr)<-br.nam colnames(ebr)<-br.nam rownames(ebr)<-clid colnames(vbr)<-br.nam rownames(vbr)<-clid out<-list(raw.nli=br,exp.nli=br.exp,sd.nli=br.sd,z.nli=br.z,raw.gli=gbr, exp.gli=egbr,sd.gli=sqrt(vgbr),z.gli=(gbr-egbr)/sqrt(vgbr),exp.grp=ebr, sd.grp=sqrt(vbr),cl=cl,clid=clid,n=n,N=N) class(out)<-"brokerage" out } #coef.bn - Coefficient method for bn coef.bn<-function(object, ...){ coef<-c(object$d,object$pi,object$sigma,object$rho) names(coef)<-c("d","pi","sigma","rho") coef } #coef.lnam - Coefficient method for lnam coef.lnam<-function(object, ...){ coefs<-vector() # cn<-vector() if(!is.null(object$beta)){ coefs<-c(coefs,object$beta) # cn<-c(cn,names(object$beta)) } if(!is.null(object$rho1)){ coefs<-c(coefs,object$rho1) # cn<-c(cn,"rho1") } if(!is.null(object$rho2)){ coefs<-c(coefs,object$rho2) # cn<-c(cn,"rho2") } # names(coefs)<-cn coefs } #consensus - Find a consensus structure, using one of several algorithms. Note #that this is currently experimental, and that the routines are not guaranteed #to produce meaningful output consensus<-function(dat,mode="digraph",diag=FALSE,method="central.graph",tol=1e-6,maxiter=1e3,verbose=TRUE,no.bias=FALSE){ #First, prepare the data dat<-as.sociomatrix.sna(dat) if(is.list(dat)) stop("consensus requires graphs of identical order.") if(is.matrix(dat)) m<-1 else m<-dim(dat)[1] n<-dim(dat)[2] if(m==1) dat<-array(dat,dim=c(1,n,n)) if(mode=="graph") d<-upper.tri.remove(dat) else d<-dat if(!diag) d<-diag.remove(d) #Now proceed by method #First, use the central graph if called for if(method=="central.graph"){ cong<-centralgraph(d) #Try the iterative reweighting algorithm.... }else if(method=="iterative.reweight"){ cong<-centralgraph(d) ans<-sweep(d,c(2,3),cong,"==") comp<-pmax(apply(ans,1,mean,na.rm=TRUE),0.5) if(no.bias) bias<-rep(0.5,length(comp)) else bias<-apply(sweep(d,c(2,3),!ans,"*"),1,mean,na.rm=TRUE) cdiff<-1+tol iter<-1 while((cdiff>tol)&&(iterll0 ans<-sweep(d,c(2,3),cong,"==") ocomp<-comp comp<-pmax(apply(ans,1,mean,na.rm=TRUE),0.5) bias<-apply(sweep(d,c(2,3),!ans,"*"),1,mean,na.rm=TRUE) cdiff<-sum(abs(ocomp-comp)) iter<-iter+1 } if(verbose){ cat("Estimated competency scores:\n") print(comp) cat("Estimated bias parameters:\n") print(bias) } #Perform a single reweighting using mean correlation }else if(method=="single.reweight"){ gc<-gcor(d) gc[is.na(gc)]<-0 diag(gc)<-1 rwv<-apply(gc,1,sum) rwv<-rwv/sum(rwv) cong<-apply(d*aperm(array(sapply(rwv,rep,n^2),dim=c(n,n,m)),c(3,2,1)),c(2,3),sum) #Perform a single reweighting using first component loadings }else if(method=="PCA.reweight"){ gc<-gcor(d) gc[is.na(gc)]<-0 diag(gc)<-1 rwv<-abs(eigen(gc)$vector[,1]) cong<-apply(d*aperm(array(sapply(rwv,rep,n^2),dim=c(n,n,m)), c(3,2,1)),c(2,3),sum) #Use the (proper) Romney-Batchelder model }else if(method=="romney.batchelder"){ d<-d[!apply(is.na(d),1,all),,] #Remove any missing informants if(length(dim(d))<3) stop("Insufficient informant information.") #Create the initial estimates drate<-apply(d,1,mean,na.rm=TRUE) cong<-apply(d,c(2,3),mean,na.rm=TRUE)>0.5 #Estimate graph s1<-mean(cong,na.rm=TRUE) s0<-mean(1-cong,na.rm=TRUE) correct<-sweep(d,c(2,3),cong,"==") #Check for correctness correct<-apply(correct,1,mean,na.rm=TRUE) comp<-pmax(2*correct-1,0) #Estimate competencies if(no.bias) bias<-rep(0.5,length(comp)) else{ bias<-pmin(pmax((drate-s1*comp)/(1-comp),0),1) bias[comp==1]<-0.5 } #Now, iterate until the system converges ocomp<-comp+tol+1 iter<-1 while((max(abs(ocomp-comp),na.rm=TRUE)>tol)&&(iterll0 s1<-mean(cong,na.rm=TRUE) s0<-mean(1-cong,na.rm=TRUE) #Estimate competencies, using EM correct<-sweep(d,c(2,3),cong,"==") #Check for correctness correct<-apply(correct,1,mean,na.rm=TRUE) comp<-pmax((correct-s1*bias-s0*(1-bias))/(1-s1*bias-s0*(1-bias)),0) #Estimate bias (if no.bias==FALSE), using EM if(!no.bias) bias<-pmin(pmax((drate-s1*comp)/(1-comp),0),1) } #Possibly, dump fun messages if(verbose){ cat("Estimated competency scores:\n") print(comp) cat("Estimated bias parameters:\n") print(bias) } #Use the Locally Aggregated Structure }else if(method=="LAS.intersection"){ cong<-matrix(0,n,n) for(i in 1:n) for(j in 1:n) cong[i,j]<-as.numeric(d[i,i,j]&&d[j,i,j]) }else if(method=="LAS.union"){ cong<-matrix(0,n,n) for(i in 1:n) for(j in 1:n) cong[i,j]<-as.numeric(d[i,i,j]||d[j,i,j]) }else if(method=="OR.row"){ cong<-matrix(0,n,n) for(i in 1:n) cong[i,]<-d[i,i,] }else if(method=="OR.col"){ cong<-matrix(0,n,n) for(i in 1:n) cong[,i]<-d[i,,i] } #Finish off and return the consensus graph if(mode=="graph") cong[upper.tri(cong)]<-t(cong)[upper.tri(cong)] if(!diag) diag(cong)<-0 cong } #eval.edgeperturbation - Evaluate a function on a given graph with and without a #given edge, returning the difference between the results in each case. eval.edgeperturbation<-function(dat,i,j,FUN,...){ #Get the function in question fun<-match.fun(FUN) #Set up the perturbation matrices present<-dat present[i,j]<-1 absent<-dat absent[i,j]<-0 #Evaluate the function across the perturbation and return the difference fun(present,...)-fun(absent,...) } #lnam - Fit a linear network autocorrelation model #y = r1 * W1 %*% y + X %*% b + e, e = r2 * W2 %*% e + nu #y = (I-r1*W1)^-1%*%(X %*% b + e) #y = (I-r1 W1)^-1 (X %*% b + (I-r2 W2)^-1 nu) #e = (I-r2 W2)^-1 nu #e = (I-r1 W1) y - X b #nu = (I - r2 W2) [ (I-r1 W1) y - X b ] #nu = (I-r2 W2) e lnam<-function(y,x=NULL,W1=NULL,W2=NULL,theta.seed=NULL,null.model=c("meanstd","mean","std","none"),method="BFGS",control=list(),tol=1e-10){ #Define the log-likelihood functions for each case agg<-function(a,w){ m<-length(w) n<-dim(a)[2] mat<-as.double(matrix(0,n,n)) matrix(.C("aggarray3d_R",as.double(a),as.double(w),mat=mat,as.integer(m), as.integer(n),PACKAGE="sna",NAOK=TRUE)$mat,n,n) } #Estimate covariate effects, conditional on autocorrelation parameters betahat<-function(y,X,W1a,W2a){ if(nw1==0){ if(nw2==0){ return(qr.solve(t(X)%*%X,t(X)%*%y)) }else{ tXtW2aW2a<-t(X)%*%t(W2a)%*%W2a return(qr.solve(tXtW2aW2a%*%X,tXtW2aW2a%*%y)) } }else{ if(nw2==0){ return(qr.solve(t(X)%*%X,t(X)%*%W1a%*%y)) }else{ tXtW2aW2a<-t(X)%*%t(W2a)%*%W2a qr.solve(tXtW2aW2a%*%X,tXtW2aW2a%*%W1a%*%y) } } } #Estimate predicted means, conditional on other effects muhat<-function(y,X,W1a,W2a,betahat){ if(nx>0) Xb<-X%*%betahat else Xb<-0 switch((nw1>0)+2*(nw2>0)+1, y-Xb, W1a%*%y-Xb, W2a%*%(y-Xb), W2a%*%(W1a%*%y-Xb) ) } #Estimate innovation variance, conditional on other effects sigmasqhat<-function(muhat){ t(muhat)%*%muhat/length(muhat) } #Model deviance (for use with fitting rho | beta, sigma) n2ll.rho<-function(rho,beta,sigmasq){ #Prepare ll elements according to which parameters are present if(nw1>0){ W1a<-diag(n)-agg(W1,rho[1:nw1]) W1ay<-W1a%*%y adetW1a<-abs(det(W1a)) }else{ W1ay<-y adetW1a<-1 } if(nw2>0){ W2a<-diag(n)-agg(W2,rho[(nw1+1):(nw1+nw2)]) tpW2a<-t(W2a)%*%W2a adetW2a<-abs(det(W2a)) }else{ tpW2a<-diag(n) adetW2a<-1 } if(nx>0){ Xb<-x%*%beta }else{ Xb<-0 } #Compute and return n*(log(2*pi)+log(sigmasq)) + t(W1ay-Xb)%*%tpW2a%*%(W1ay-Xb)/sigmasq - 2*(log(adetW1a)+log(adetW2a)) } #Model deviance (general purpose) n2ll<-function(W1a,W2a,sigmasqhat){ switch((nw1>0)+2*(nw2>0)+1, n*(1+log(2*pi)+log(sigmasqhat)), n*(1+log(2*pi)+log(sigmasqhat))-2*log(abs(det(W1a))), n*(1+log(2*pi)+log(sigmasqhat))-2*log(abs(det(W2a))), n*(1+log(2*pi)+log(sigmasqhat))- 2*(log(abs(det(W1a)))+log(abs(det(W2a)))) ) } #Conduct a single iterative refinement of a set of initial parameter estimates estimate<-function(parm,final=FALSE){ #Either aggregate the weight matrices, or NULL them if(nw1>0) W1a<-diag(n)-agg(W1,parm$rho1) else W1a<-NULL if(nw2>0) W2a<-diag(n)-agg(W2,parm$rho2) else W2a<-NULL #If covariates were given, estimate beta | rho if(nx>0) parm$beta<-betahat(y,x,W1a,W2a) #Estimate sigma | beta, rho parm$sigmasq<-sigmasqhat(muhat(y,x,W1a,W2a,parm$beta)) #If networks were given, (and not final) estimate rho | beta, sigma if(!(final||(nw1+nw2==0))){ rho<-c(parm$rho1,parm$rho2) temp<-optim(rho,n2ll.rho,method=method,control=control,beta=parm$beta, sigmasq=parm$sigmasq) if(nw1>0) parm$rho1<-temp$par[1:nw1] if(nw2>0) parm$rho2<-temp$par[(nw1+1):(nw1+nw2)] } #Calculate model deviance parm$dev<-n2ll(W1a,W2a,parm$sigmasq) #Return the parameter list parm } #Calculate the expected Fisher information matrix for a fitted model infomat<-function(parm){ #Numerical version (requires numDeriv) requireNamespace('numDeriv') locnll<-function(par){ #Prepare ll elements according to which parameters are present if(nw1>0){ W1a<-diag(n)-agg(W1,par[(nx+1):(nx+nw1)]) W1ay<-W1a%*%y ladetW1a<-log(abs(det(W1a))) }else{ W1ay<-y ladetW1a<-0 } if(nw2>0){ W2a<-diag(n)-agg(W2,par[(nx+nw1+1):(nx+nw1+nw2)]) tpW2a<-t(W2a)%*%W2a ladetW2a<-log(abs(det(W2a))) }else{ tpW2a<-diag(n) ladetW2a<-0 } if(nx>0){ Xb<-x%*%par[1:nx] }else{ Xb<-0 } #Compute and return n/2*(log(2*pi)+log(par[m]))+ t(W1ay-Xb)%*%tpW2a%*%(W1ay-Xb)/(2*par[m]) -ladetW1a-ladetW2a } #Return the information matrix numDeriv::hessian(locnll,c(parm$beta,parm$rho1,parm$rho2,parm$sigmasq)) } #How many data points are there? n<-length(y) #Fix x, W1, and W2, if needed, and count predictors if(!is.null(x)){ if(is.vector(x)) x<-as.matrix(x) if(NROW(x)!=n) stop("Number of observations in x must match length of y.") nx<-NCOL(x) }else nx<-0 if(!is.null(W1)){ W1<-as.sociomatrix.sna(W1) if(!(is.matrix(W1)||is.array(W1))) stop("All networks supplied in W1 must be of identical order.") if(dim(W1)[2]!=n) stop("Order of W1 must match length of y.") if(length(dim(W1))==2) W1<-array(W1,dim=c(1,n,n)) nw1<-dim(W1)[1] }else nw1<-0 if(!is.null(W2)){ W2<-as.sociomatrix.sna(W2) if(!(is.matrix(W2)||is.array(W2))) stop("All networks supplied in W2 must be of identical order.") if(dim(W2)[2]!=n) stop("Order of W2 must match length of y.") if(length(dim(W2))==2) W2<-array(W2,dim=c(1,n,n)) nw2<-dim(W2)[1] }else nw2<-0 #Determine the computation mode from the x,W1,W2 parameters comp.mode<-as.character(as.numeric(1*(nx>0)+10*(nw1>0)+100*(nw2>0))) if(comp.mode=="0") stop("At least one of x, W1, W2 must be specified.\n") #How many predictors? m<-switch(comp.mode, "1"=nx+1, "10"=nw1+1, "100"=nw2+1, "11"=nx+nw1+1, "101"=nx+nw2+1, "110"=nw1+nw2+1, "111"=nx+nw1+nw2+1 ) #Initialize the parameter list parm<-list() if(is.null(theta.seed)){ if(nx>0) parm$beta<-rep(0,nx) if(nw1>0) parm$rho1<-rep(0,nw1) if(nw2>0) parm$rho2<-rep(0,nw2) parm$sigmasq<-1 }else{ if(nx>0) parm$beta<-theta.seed[1:nx] if(nw1>0) parm$rho1<-theta.seed[(nx+1):(nx+nw1)] if(nw2>0) parm$rho2<-theta.seed[(nx+nw1+1):(nx+nw1+nw2)] parm$sigmasq<-theta.seed[nx+nw1+nw2+1] } parm$dev<-Inf #Fit the model olddev<-Inf while(is.na(parm$dev-olddev)||(abs(parm$dev-olddev)>tol)){ olddev<-parm$dev parm<-estimate(parm,final=FALSE) } parm<-estimate(parm,final=TRUE) #Final refinement #Assemble the result o<-list() o$y<-y o$x<-x o$W1<-W1 o$W2<-W2 o$model<-comp.mode o$infomat<-infomat(parm) o$acvm<-qr.solve(o$infomat) o$null.model<-match.arg(null.model) o$lnlik.null<-switch(match.arg(null.model), #Fit a null model "meanstd"=sum(dnorm(y-mean(y),0,as.numeric(sqrt(var(y))),log=TRUE)), "mean"=sum(dnorm(y-mean(y),log=TRUE)), "std"=sum(dnorm(y,0,as.numeric(sqrt(var(y))),log=TRUE)), "none"=sum(dnorm(y,log=TRUE)) ) o$df.null.resid<-switch(match.arg(null.model), #Find residual null df "meanstd"=n-2, "mean"=n-1, "std"=n-1, "none"=n ) o$df.null<-switch(match.arg(null.model), #Find null df "meanstd"=2, "mean"=1, "std"=1, "none"=0 ) o$null.param<-switch(match.arg(null.model), #Find null params, if any "meanstd"=c(mean(y),sqrt(var(y))), "mean"=mean(y), "std"=sqrt(var(y)), "none"=NULL ) o$lnlik.model<--parm$dev/2 o$df.model<-m o$df.residual<-n-m o$df.total<-n o$beta<-parm$beta #Extract parameters o$rho1<-parm$rho1 o$rho2<-parm$rho2 o$sigmasq<-parm$sigmasq o$sigma<-o$sigmasq^0.5 temp<-sqrt(diag(o$acvm)) #Get standard errors if(nx>0) o$beta.se<-temp[1:nx] if(nw1>0) o$rho1.se<-temp[(nx+1):(nx+nw1)] if(nw2>0) o$rho2.se<-temp[(nx+nw1+1):(nx+nw1+nw2)] o$sigmasq.se<-temp[m] o$sigma.se<-o$sigmasq.se^2/(4*o$sigmasq) #This a delta method approximation if(!is.null(o$beta)){ #Set X names if(!is.null(colnames(x))){ names(o$beta)<-colnames(x) names(o$beta.se)<-colnames(x) }else{ names(o$beta)<-paste("X",1:nx,sep="") names(o$beta.se)<-paste("X",1:nx,sep="") } } if(!is.null(o$rho1)){ #Set W1 names if((!is.null(dimnames(W1)))&&(!is.null(dimnames(W1)[[1]]))){ names(o$rho1)<-dimnames(W1)[[1]] names(o$rho1.se)<-dimnames(W1)[[1]] }else{ names(o$rho1)<-paste("rho1",1:nw1,sep=".") names(o$rho1.se)<-paste("rho1",1:nw1,sep=".") } } if(!is.null(o$rho2)){ #Set W2 names if((!is.null(dimnames(W2)))&&(!is.null(dimnames(W2)[[1]]))){ names(o$rho2)<-dimnames(W2)[[1]] names(o$rho2.se)<-dimnames(W2)[[1]] }else{ names(o$rho2)<-paste("rho2",1:nw2,sep=".") names(o$rho2.se)<-paste("rho2",1:nw2,sep=".") } } if(nw1>0) #Aggregate W1 weights W1ag<-agg(W1,o$rho1) if(nw2>0) #Aggregate W2 weights W2ag<-agg(W2,o$rho2) o$disturbances<-as.vector(switch(comp.mode, #The estimated disturbances "1"=y-x%*%o$beta, "10"=(diag(n)-W1ag)%*%y, "100"=(diag(n)-W2ag)%*%y, "11"=(diag(n)-W1ag)%*%y-x%*%o$beta, "101"=(diag(n)-W2ag)%*%(y-x%*%o$beta), "110"=(diag(n)-W2ag)%*%((diag(n)-W1ag)%*%y), "111"=(diag(n)-W2ag)%*%((diag(n)-W1ag)%*%y-x%*%o$beta) )) o$fitted.values<-as.vector(switch(comp.mode, #Compute the fitted values "1"=x%*%o$beta, "10"=rep(0,n), "100"=rep(0,n), "11"=qr.solve(diag(n)-W1ag,x%*%o$beta), "101"=x%*%o$beta, "110"=rep(0,n), "111"=qr.solve(diag(n)-W1ag,x%*%o$beta) )) o$residuals<-as.vector(y-o$fitted.values) o$call<-match.call() class(o)<-c("lnam") o } #nacf - Network autocorrelation function nacf<-function(net,y,lag.max=NULL,type=c("correlation","covariance","moran","geary"),neighborhood.type=c("in","out","total"),partial.neighborhood=TRUE,mode="digraph",diag=FALSE,thresh=0,demean=TRUE){ #Pre-process the raw input net<-as.sociomatrix.sna(net) if(is.list(net)) return(lapply(net,nacf,y=y,lag.max=lag.max, neighborhood.type=neighborhood.type,partial.neighborhood=partial.neighborhood,mode=mode,diag=diag,thresh=thresh,demean=demean)) else if(length(dim(net))>2) return(apply(net,1,nacf,y=y,lag.max=lag.max, neighborhood.type=neighborhood.type,partial.neighborhood=partial.neighborhood,mode=mode,diag=diag,thresh=thresh,demean=demean)) #End pre-processing if(length(y)!=NROW(net)) stop("Network size must match covariate length in nacf.") #Process y if(demean||(match.arg(type)=="moran")) y<-y-mean(y) vary<-var(y) #Determine maximum lag, if needed if(is.null(lag.max)) lag.max<-NROW(net)-1 #Get the appropriate neighborhood graphs for dat neigh<-neighborhood(net,order=lag.max,neighborhood.type=neighborhood.type, mode=mode,diag=diag,thresh=thresh,return.all=TRUE,partial=partial.neighborhood) #Form the coefficients v<-switch(match.arg(type), "covariance"=t(y)%*%y/NROW(net), "correlation"=1, "moran"=1, "geary"=0, ) for(i in 1:lag.max){ ec<-sum(neigh[i,,]) if(ec>0){ v[i+1]<-switch(match.arg(type), "covariance"=(t(y)%*%neigh[i,,]%*%y)/ec, "correlation"=((t(y)%*%neigh[i,,]%*%y)/ec)/vary, "moran"=NROW(net)/ec*sum((y%o%y)*neigh[i,,])/sum(y^2), "geary"=(NROW(net)-1)/(2*ec)*sum(neigh[i,,]*outer(y,y,"-")^2)/ sum((y-mean(y))^2), ) }else v[i+1]<-0 } names(v)<-0:lag.max #Return the results v } #netcancor - Canonical correlations for network variables. netcancor<-function(y,x,mode="digraph",diag=FALSE,nullhyp="cugtie",reps=1000){ y<-as.sociomatrix.sna(y) x<-as.sociomatrix.sna(x) if(is.list(x)|is.list(y)) stop("netcancor requires graphs of identical order.") if(length(dim(y))>2){ iy<-matrix(nrow=dim(y)[1],ncol=dim(y)[2]*dim(y)[3]) }else{ iy<-matrix(nrow=1,ncol=dim(y)[1]*dim(y)[2]) temp<-y y<-array(dim=c(1,dim(temp)[1],dim(temp)[2])) y[1,,]<-temp } if(length(dim(x))>2){ ix<-matrix(nrow=dim(x)[1],ncol=dim(x)[2]*dim(x)[3]) }else{ ix<-matrix(nrow=1,ncol=dim(x)[1]*dim(x)[2]) temp<-x x<-array(dim=c(1,dim(temp)[1],dim(temp)[2])) x[1,,]<-temp } my<-dim(y)[1] mx<-dim(x)[1] n<-dim(y)[2] out<-list() out$xdist<-array(dim=c(reps,mx,mx)) out$ydist<-array(dim=c(reps,my,my)) #Convert the response first. for(i in 1:my){ d<-y[i,,] #if(!diag){ # diag(d)<-NA #} #if(mode!="digraph") # d[lower.tri(d)]<-NA iy[i,]<-as.vector(d) } #Now for the independent variables. for(i in 1:mx){ d<-x[i,,] #if(!diag){ # diag(d)<-NA #} #if(mode!="digraph") # d[lower.tri(d)]<-NA ix[i,]<-as.vector(d) } #Run the initial model fit nc<-cancor(t(ix),t(iy)) #Had to take out na.action=na.omit, since it's not supported #Now, repeat the whole thing an ungodly number of times. out$cdist<-array(dim=c(reps,length(nc$cor))) for(i in 1:reps){ #Clear out the internal structures iy<-matrix(nrow=dim(y)[1],ncol=dim(y)[2]*dim(y)[3]) ix<-matrix(nrow=dim(x)[1],ncol=dim(x)[2]*dim(x)[3]) #Convert (and mutate) the response first. for(j in 1:my){ d<-switch(nullhyp, qap = rmperm(y[j,,]), cug = rgraph(n,1,mode=mode,diag=diag), cugden = rgraph(n,1,tprob=gden(y[j,,],mode=mode,diag=diag),mode=mode,diag=diag), cugtie = rgraph(n,1,mode=mode,diag=diag,tielist=y[j,,]) ) #if(!diag){ # diag(d)<-NA #} #if(mode!="digraph") # d[lower.tri(d)]<-NA iy[j,]<-as.vector(d) } #Now for the independent variables. for(j in 1:mx){ d<-switch(nullhyp, qap = rmperm(x[j,,]), cug = rgraph(n,1,mode=mode,diag=diag), cugden = rgraph(n,1,tprob=gden(x[j,,],mode=mode,diag=diag),mode=mode,diag=diag), cugtie = rgraph(n,1,mode=mode,diag=diag,tielist=x[j,,]) ) #if(!diag){ # diag(d)<-NA #} #if(mode!="digraph") # d[lower.tri(d)]<-NA ix[j,]<-as.vector(d) } #Finally, fit the test model tc<-cancor(t(ix),t(iy)) #Had to take out na.action=na.omit, since it's not supported #Gather the coefficients for use later... out$cdist[i,]<-tc$cor out$xdist[i,,]<-tc$xcoef out$ydist[i,,]<-tc$ycoef } #Find the p-values for our monte carlo null hypothesis tests out$cor<-nc$cor out$xcoef<-nc$xcoef out$ycoef<-nc$ycoef out$cpgreq<-vector(length=length(nc$cor)) out$cpleeq<-vector(length=length(nc$cor)) for(i in 1:length(nc$cor)){ out$cpgreq[i]<-mean(out$cdist[,i]>=out$cor[i],na.rm=TRUE) out$cpleeq[i]<-mean(out$cdist[,i]<=out$cor[i],na.rm=TRUE) } out$xpgreq<-matrix(ncol=mx,nrow=mx) out$xpleeq<-matrix(ncol=mx,nrow=mx) for(i in 1:mx){ for(j in 1:mx){ out$xpgreq[i,j]<-mean(out$xdist[,i,j]>=out$xcoef[i,j],na.rm=TRUE) out$xpleeq[i,j]<-mean(out$xdist[,i,j]<=out$xcoef[i,j],na.rm=TRUE) } } out$ypgreq<-matrix(ncol=my,nrow=my) out$ypleeq<-matrix(ncol=my,nrow=my) for(i in 1:my){ for(j in 1:my){ out$ypgreq[i,j]<-mean(out$ydist[,i,j]>=out$ycoef[i,j],na.rm=TRUE) out$ypleeq[i,j]<-mean(out$ydist[,i,j]<=out$ycoef[i,j],na.rm=TRUE) } } #Having completed the model fit and MC tests, we gather useful information for #the end user. This is a combination of cancor output and our own stuff. out$cnames<-as.vector(paste("cor",1:min(mx,my),sep="")) out$xnames<-as.vector(paste("x",1:mx,sep="")) out$ynames<-as.vector(paste("y",1:my,sep="")) out$xcenter<-nc$xcenter out$ycenter<-nc$ycenter out$nullhyp<-nullhyp class(out)<-c("netcancor") out } #netlm - OLS network regrssion routine (w/many null hypotheses) # #QAP semi-partialling "plus" (Dekker et al.) # #For Y ~ b0 + b1 X1 + b2 X2 + ... + bp Xp # #for(i in 1:p) # # Fit Xi ~ b0* + b1* X1 + ... + bp* Xp (omit Xi) # # Let ei = resid of above lm # # for(j in 1:reps) # # eij = rmperm (ei) # # Fit Y ~ b0** + b1** X1 + ... + bi** eij + ... + bp** Xp # #Use resulting permutation distributions to test coefficients netlm<-function(y,x,intercept=TRUE,mode="digraph",diag=FALSE,nullhyp=c("qap", "qapspp","qapy","qapx","qapallx","cugtie","cugden","cuguman","classical"),test.statistic=c("t-value","beta"),tol=1e-7, reps=1000){ #Define an internal routine to perform a QR reduction and get t-values gettval<-function(x,y,tol){ xqr<-qr(x,tol=tol) coef<-qr.coef(xqr,y) resid<-qr.resid(xqr,y) rank<-xqr$rank n<-length(y) rdf<-n-rank resvar<-sum(resid^2)/rdf cvm<-chol2inv(xqr$qr) se<-sqrt(diag(cvm)*resvar) coef/se } #Define an internal routine to quickly fit linear models to graphs gfit<-function(glist,mode,diag,tol,rety,tstat){ y<-gvectorize(glist[[1]],mode=mode,diag=diag,censor.as.na=TRUE) x<-vector() for(i in 2:length(glist)) x<-cbind(x,gvectorize(glist[[i]],mode=mode,diag=diag,censor.as.na=TRUE)) if(!is.matrix(x)) x<-matrix(x,ncol=1) mis<-is.na(y)|apply(is.na(x),1,any) if(!rety){ if(tstat=="beta") qr.solve(x[!mis,],y[!mis],tol=tol) else if(tstat=="t-value"){ gettval(x[!mis,],y[!mis],tol=tol) } }else{ list(qr(x[!mis,],tol=tol),y[!mis]) } } #Get the data in order y<-as.sociomatrix.sna(y) x<-as.sociomatrix.sna(x) if(is.list(y)||((length(dim(y))>2)&&(dim(y)[1]>1))) stop("y must be a single graph in netlm.") if(length(dim(y))>2) y<-y[1,,] if(is.list(x)||(dim(x)[2]!=dim(y)[2])) stop("Homogeneous graph orders required in netlm.") nx<-stackcount(x)+intercept #Get number of predictors n<-dim(y)[2] #Get graph order g<-list(y) #Put graphs into a list if(intercept) g[[2]]<-matrix(1,n,n) if(nx-intercept==1) g[[2+intercept]]<-x else for(i in 1:(nx-intercept)) g[[i+1+intercept]]<-x[i,,] if(any(sapply(lapply(g,is.na),any))) warning("Missing data supplied to netlm; this may pose problems for certain null hypotheses. Hope you know what you're doing....") #Fit the initial baseline model fit.base<-gfit(g,mode=mode,diag=diag,tol=tol,rety=TRUE) fit<-list() #Initialize output fit$coefficients<-qr.coef(fit.base[[1]],fit.base[[2]]) fit$fitted.values<-qr.fitted(fit.base[[1]],fit.base[[2]]) fit$residuals<-qr.resid(fit.base[[1]],fit.base[[2]]) fit$qr<-fit.base[[1]] fit$rank<-fit.base[[1]]$rank fit$n<-length(fit.base[[2]]) fit$df.residual<-fit$n-fit$rank tstat<-match.arg(test.statistic) if(tstat=="beta") fit$tstat<-fit$coefficients else if(tstat=="t-value") fit$tstat<-fit$coefficients/ sqrt(diag(chol2inv(fit$qr$qr))*sum(fit$residuals^2)/(fit$n-fit$rank)) #Proceed based on selected null hypothesis nullhyp<-match.arg(nullhyp) if((nullhyp%in%c("qap","qapspp"))&&(nx==1)) #No partialling w/one predictor nullhyp<-"qapy" if(nullhyp=="classical"){ resvar<-sum(fit$residuals^2)/fit$df.residual cvm<-chol2inv(fit$qr$qr) se<-sqrt(diag(cvm)*resvar) tval<-fit$coefficients/se #Prepare output fit$dist<-NULL fit$pleeq<-pt(tval,fit$df.residual) fit$pgreq<-pt(tval,fit$df.residual,lower.tail=FALSE) fit$pgreqabs<-2*pt(abs(tval),fit$df.residual,lower.tail=FALSE) }else if(nullhyp%in%c("cugtie","cugden","cuguman")){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ gr<-g for(j in 1:reps){ #Modify the focal x gr[[i+1]]<-switch(nullhyp, cugtie=rgraph(n,mode=mode,diag=diag,replace=FALSE,tielist=g[[i+1]]), cugden=rgraph(n,tprob=gden(g[[i+1]],mode=mode,diag=diag),mode=mode, diag=diag), cuguman=(function(dc,n){rguman(1,n,mut=dc[1],asym=dc[2],null=dc[3], method="exact")})(dyad.census(g[[i+1]]),n) ) #Fit model with modified x repdist[j,i]<-gfit(gr,mode=mode,diag=diag,tol=tol,rety=FALSE, tstat=tstat)[i] } } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapy"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) gr<-g for(i in 1:reps){ gr[[1]]<-rmperm(g[[1]]) #Permute y #Fit the model under replication repdist[i,]<-gfit(gr,mode=mode,diag=diag,tol=tol,rety=FALSE,tstat=tstat) } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapx"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ gr<-g for(j in 1:reps){ gr[[i+1]]<-rmperm(gr[[i+1]]) #Modify the focal x #Fit model with modified x repdist[j,i]<-gfit(gr,mode=mode,diag=diag,tol=tol,rety=FALSE, tstat=tstat)[i] } } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapallx"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) gr<-g for(i in 1:reps){ for(j in 1:nx) gr[[1+j]]<-rmperm(g[[1+j]]) #Permute each x #Fit the model under replication repdist[i,]<-gfit(gr,mode=mode,diag=diag,tol=tol,rety=FALSE, tstat=tstat) } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if((nullhyp=="qap")||(nullhyp=="qapspp")){ xsel<-matrix(TRUE,n,n) if(!diag) diag(xsel)<-FALSE if(mode=="graph") xsel[upper.tri(xsel)]<-FALSE #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ #Regress x_i on other x's xfit<-gfit(g[1+c(i,(1:nx)[-i])],mode=mode,diag=diag,tol=tol,rety=TRUE, tstat=tstat) xres<-g[[1+i]] xres[xsel]<-qr.resid(xfit[[1]],xfit[[2]]) #Get residuals of x_i if(mode=="graph") xres[upper.tri(xres)]<-t(xres)[upper.tri(xres)] #Draw replicate coefs using permuted x residuals for(j in 1:reps) repdist[j,i]<-gfit(c(g[-(1+i)],list(rmperm(xres))),mode=mode,diag=diag, tol=tol,rety=FALSE,tstat=tstat)[nx] } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) } #Finalize the results fit$nullhyp<-nullhyp fit$names<-paste("x",1:(nx-intercept),sep="") if(intercept) fit$names<-c("(intercept)",fit$names) fit$intercept<-intercept class(fit)<-"netlm" #Return the result fit } #netlogit - God help me, it's a network regression routine using a #binomial/logit GLM. It's also frighteningly slow, since it's essentially a #front end to the builtin GLM routine with a bunch of network hypothesis testing #stuff thrown in for good measure. netlogit<-function(y,x,intercept=TRUE,mode="digraph",diag=FALSE,nullhyp=c("qap", "qapspp","qapy","qapx","qapallx","cugtie","cugden","cuguman","classical"), test.statistic=c("z-value","beta"), tol=1e-7,reps=1000){ #Define an internal routine to quickly fit logit models to graphs gfit<-function(glist,mode,diag){ y<-gvectorize(glist[[1]],mode=mode,diag=diag,censor.as.na=TRUE) x<-vector() for(i in 2:length(glist)) x<-cbind(x,gvectorize(glist[[i]],mode=mode,diag=diag,censor.as.na=TRUE)) if(!is.matrix(x)) x<-matrix(x,ncol=1) mis<-is.na(y)|apply(is.na(x),1,any) glm.fit(x[!mis,],y[!mis],family=binomial(),intercept=FALSE) } #Repeat the above, for strictly linear models gfitlm<-function(glist,mode,diag,tol){ y<-gvectorize(glist[[1]],mode=mode,diag=diag,censor.as.na=TRUE) x<-vector() for(i in 2:length(glist)) x<-cbind(x,gvectorize(glist[[i]],mode=mode,diag=diag,censor.as.na=TRUE)) if(!is.matrix(x)) x<-matrix(x,ncol=1) mis<-is.na(y)|apply(is.na(x),1,any) list(qr(x[!mis,],tol=tol),y[!mis]) } #Get the data in order y<-as.sociomatrix.sna(y) x<-as.sociomatrix.sna(x) if(is.list(y)||((length(dim(y))>2)&&(dim(y)[1]>1))) stop("y must be a single graph in netlogit.") if(length(dim(y))>2) y<-y[1,,] if(is.list(x)||(dim(x)[2]!=dim(y)[2])) stop("Homogeneous graph orders required in netlogit.") nx<-stackcount(x)+intercept #Get number of predictors n<-dim(y)[2] #Get graph order g<-list(y) #Put graphs into a list if(intercept) g[[2]]<-matrix(1,n,n) if(nx-intercept==1) g[[2+intercept]]<-x else for(i in 1:(nx-intercept)) g[[i+1+intercept]]<-x[i,,] if(any(sapply(lapply(g,is.na),any))) warning("Missing data supplied to netlogit; this may pose problems for certain null hypotheses. Hope you know what you're doing....") #Fit the initial baseline model fit.base<-gfit(g,mode=mode,diag=diag) fit<-list() #Initialize output fit$coefficients<-fit.base$coefficients fit$fitted.values<-fit.base$fitted.values fit$residuals<-fit.base$residuals fit$se<-sqrt(diag(chol2inv(fit.base$qr$qr))) tstat<-match.arg(test.statistic) fit$test.statistic<-tstat if(tstat=="beta") fit$tstat<-fit$coefficients else if(tstat=="z-value") fit$tstat<-fit$coefficients/fit$se fit$linear.predictors<-fit.base$linear.predictors fit$n<-length(fit.base$y) fit$df.model<-fit.base$rank fit$df.residual<-fit.base$df.residual fit$deviance<-fit.base$deviance fit$null.deviance<-fit.base$null.deviance fit$df.null<-fit.base$df.null fit$aic<-fit.base$aic fit$bic<-fit$deviance+fit$df.model*log(fit$n) fit$qr<-fit.base$qr fit$ctable<-table(as.numeric(fit$fitted.values>=0.5),fit.base$y, dnn=c("Predicted","Actual")) #Get the contingency table if(NROW(fit$ctable)==1){ if(rownames(fit$ctable)=="0") fit$ctable<-rbind(fit$ctable,c(0,0)) else fit$ctable<-rbind(c(0,0),fit$ctable) rownames(fit$ctable)<-c("0","1") } #Proceed based on selected null hypothesis nullhyp<-match.arg(nullhyp) if((nullhyp%in%c("qap","qapspp"))&&(nx==1)) #No partialling w/one predictor nullhyp<-"qapy" if(nullhyp=="classical"){ cvm<-chol2inv(fit$qr$qr) se<-sqrt(diag(cvm)) tval<-fit$coefficients/se #Prepare output fit$dist<-NULL fit$pleeq<-pt(tval,fit$df.residual) fit$pgreq<-pt(tval,fit$df.residual,lower.tail=FALSE) fit$pgreqabs<-2*pt(abs(tval),fit$df.residual,lower.tail=FALSE) }else if(nullhyp%in%c("cugtie","cugden","cuguman")){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ gr<-g for(j in 1:reps){ #Modify the focal x gr[[i+1]]<-switch(nullhyp, cugtie=rgraph(n,mode=mode,diag=diag,replace=FALSE,tielist=g[[i+1]]), cugden=rgraph(n,tprob=gden(g[[i+1]],mode=mode,diag=diag),mode=mode, diag=diag), cuguman=(function(dc,n){rguman(1,n,mut=dc[1],asym=dc[2],null=dc[3], method="exact")})(dyad.census(g[[i+1]]),n) ) #Fit model with modified x repfit<-gfit(gr,mode=mode,diag=diag) if(tstat=="beta") repdist[j,i]<-repfit$coef[i] else repdist[j,i]<-repfit$coef[i]/sqrt(diag(chol2inv(repfit$qr$qr)))[i] } } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapy"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) gr<-g for(i in 1:reps){ gr[[1]]<-rmperm(g[[1]]) #Permute y #Fit the model under replication repfit<-gfit(gr,mode=mode,diag=diag) if(tstat=="beta") repdist[i,]<-repfit$coef else repdist[i,]<-repfit$coef/sqrt(diag(chol2inv(repfit$qr$qr))) } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapx"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ gr<-g for(j in 1:reps){ gr[[i+1]]<-rmperm(gr[[i+1]]) #Modify the focal x #Fit model with modified x repfit<-gfit(gr,mode=mode,diag=diag) if(tstat=="beta") repdist[j,i]<-repfit$coef[i] else repdist[j,i]<-repfit$coef[i]/sqrt(diag(chol2inv(repfit$qr$qr)))[i] } } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if(nullhyp=="qapallx"){ #Generate replicates for each predictor repdist<-matrix(0,reps,nx) gr<-g for(i in 1:reps){ for(j in 1:nx) gr[[1+j]]<-rmperm(g[[1+j]]) #Permute each x #Fit the model under replication repfit<-gfit(gr,mode=mode,diag=diag) if(tstat=="beta") repdist[i,]<-repfit$coef else repdist[i,]<-repfit$coef/sqrt(diag(chol2inv(repfit$qr$qr))) } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) }else if((nullhyp=="qap")||(nullhyp=="qapspp")){ xsel<-matrix(TRUE,n,n) if(!diag) diag(xsel)<-FALSE if(mode=="graph") xsel[upper.tri(xsel)]<-FALSE #Generate replicates for each predictor repdist<-matrix(0,reps,nx) for(i in 1:nx){ #Regress x_i on other x's xfit<-gfitlm(g[1+c(i,(1:nx)[-i])],mode=mode,diag=diag,tol=tol) xres<-g[[1+i]] xres[xsel]<-qr.resid(xfit[[1]],xfit[[2]]) #Get residuals of x_i if(mode=="graph") xres[upper.tri(xres)]<-t(xres)[upper.tri(xres)] #Draw replicate coefs using permuted x residuals for(j in 1:reps){ repfit<-gfit(c(g[-(1+i)],list(rmperm(xres))),mode=mode, diag=diag) if(tstat=="beta") repdist[j,i]<-repfit$coef[nx] else repdist[j,i]<-repfit$coef[nx]/sqrt(diag(chol2inv(repfit$qr$qr)))[nx] } } #Prepare output fit$dist<-repdist fit$pleeq<-apply(sweep(fit$dist,2,fit$tstat,"<="),2,mean) fit$pgreq<-apply(sweep(fit$dist,2,fit$tstat,">="),2,mean) fit$pgreqabs<-apply(sweep(abs(fit$dist),2,abs(fit$tstat),">="),2, mean) } #Finalize the results fit$nullhyp<-nullhyp fit$names<-paste("x",1:(nx-intercept),sep="") if(intercept) fit$names<-c("(intercept)",fit$names) fit$intercept<-intercept class(fit)<-"netlogit" #Return the result fit } #npostpred - Take posterior predictive draws for functions of networks. npostpred<-function(b,FUN,...){ #Find the desired function fun<-match.fun(FUN) #Take the draws out<-apply(b$net,1,fun,...) out } #plot.bbnam - Plot method for bbnam plot.bbnam<-function(x,mode="density",intlines=TRUE,...){ UseMethod("plot",x) } #plot.bbnam.actor - Plot method for bbnam.actor plot.bbnam.actor<-function(x,mode="density",intlines=TRUE,...){ #Get the initial graphical settings, so we can restore them later oldpar<-par(no.readonly=TRUE) #Change plotting params par(ask=dev.interactive()) #Initial plot: global error distribution par(mfrow=c(2,1)) if(mode=="density"){ #Approximate the pdf using kernel density estimation #Plot marginal population (i.e. across actors) density of p(false negative) plot(density(x$em),main=substitute(paste("Estimated Marginal Population Density of ",{e^{"-"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"-"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em,c(0.05,0.5,0.95)),lty=c(3,2,3)) #Plot marginal population (i.e. across actors) density of p(false positive) plot(density(x$ep),main=substitute(paste("Estimated Marginal Population Density of ",{e^{"+"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"+"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep,c(0.05,0.5,0.95)),lty=c(3,2,3)) }else{ #Use histograms to plot the estimated density #Plot marginal population (i.e. across actors) density of p(false negative) hist(x$em,main=substitute(paste("Histogram of ",{e^{"-"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"-"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em,c(0.05,0.5,0.95)),lty=c(3,2,3)) #Plot marginal population (i.e. across actors) density of p(false positive) hist(x$ep,main=substitute(paste("Histogram of ",{e^{"+"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"+"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep,c(0.05,0.5,0.95)),lty=c(3,2,3)) } #Plot e- next par(mfrow=c(floor(sqrt(x$nobservers)),ceiling(sqrt(x$nobservers)))) for(i in 1:x$nobservers){ if(mode=="density"){ plot(density(x$em[,i]),main=substitute({e^{"-"}}[it],list(it=i)), xlab=substitute({e^{"-"}}[it],list(it=i)),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em[,i],c(0.05,0.5,0.95)),lty=c(3,2,3)) }else{ hist(x$em[,i],main=substitute({e^{"-"}}[it],list(it=i)), xlab=substitute({e^{"-"}}[it],list(it=i)),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em[,i],c(0.05,0.5,0.95)),lty=c(3,2,3)) } } #Now plot e+ par(mfrow=c(floor(sqrt(x$nobservers)),ceiling(sqrt(x$nobservers)))) for(i in 1:x$nobservers){ if(mode=="density"){ plot(density(x$ep[,i]),main=substitute({e^{"+"}}[it],list(it=i)), xlab=substitute({e^{"+"}}[it],list(it=i)),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep[,i],c(0.05,0.5,0.95)),lty=c(3,2,3)) }else{ hist(x$ep[,i],main=substitute({e^{"+"}}[it],list(it=i)), xlab=substitute({e^{"+"}}[it],list(it=i)),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep[,i],c(0.05,0.5,0.95)),lty=c(3,2,3)) } } #Finally, try to plot histograms of tie probabilities par(mfrow=c(1,1)) plot.sociomatrix(apply(x$net,c(2,3),mean),labels=list(x$anames,x$anames),main="Marginal Posterior Tie Probability Distribution") #Clean up par(oldpar) } #plot.bbnam.fixed - Plot method for bbnam.fixed plot.bbnam.fixed<-function(x,mode="density",intlines=TRUE,...){ #Get the initial graphical settings, so we can restore them later oldpar<-par() #Perform matrix plot of tie probabilities par(mfrow=c(1,1)) plot.sociomatrix(apply(x$net,c(2,3),mean),labels=list(x$anames,x$anames),main="Marginal Posterior Tie Probability Distribution") #Clean up par(oldpar) } #plot.bbnam.pooled - Plot method for bbnam.pooled plot.bbnam.pooled<-function(x,mode="density",intlines=TRUE,...){ #Get the initial graphical settings, so we can restore them later oldpar<-par() #Change plotting params par(ask=dev.interactive()) #Initial plot: pooled error distribution par(mfrow=c(2,1)) if(mode=="density"){ #Approximate the pdf using kernel density estimation #Plot marginal population (i.e. across actors) density of p(false negative) plot(density(x$em),main=substitute(paste("Estimated Marginal Posterior Density of ",{e^{"-"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"-"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em,c(0.05,0.5,0.95)),lty=c(3,2,3)) #Plot marginal population (i.e. across actors) density of p(false positive) plot(density(x$ep),main=substitute(paste("Estimated Marginal Posterior Density of ",{e^{"+"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"+"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep,c(0.05,0.5,0.95)),lty=c(3,2,3)) }else{ #Use histograms to plot the estimated density #Plot marginal population (i.e. across actors) density of p(false negative) hist(x$em,main=substitute(paste("Histogram of ",{e^{"-"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"-"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$em,c(0.05,0.5,0.95)),lty=c(3,2,3)) #Plot marginal population (i.e. across actors) density of p(false positive) hist(x$ep,main=substitute(paste("Histogram of ",{e^{"+"}},", ",draws," Draws"),list(draws=x$draws)),xlab=expression({e^{"+"}}),xlim=c(0,1),...) #Plot interval lines if required. if(intlines) abline(v=quantile(x$ep,c(0.05,0.5,0.95)),lty=c(3,2,3)) } #Finally, try to plot histograms of tie probabilities par(mfrow=c(1,1)) plot.sociomatrix(apply(x$net,c(2,3),mean),labels=list(x$anames,x$anames),main="Marginal Posterior Tie Probability Distribution") #Clean up par(oldpar) } #plot.bn - Plot method for bn plot.bn<-function(x,...){ op<-par(no.readonly=TRUE) #Store old plotting params on.exit(par(op)) #Reset when finished par(mfrow=c(2,2)) #Dyad plot dc<-sum(x$dyads) #Get # dyads dp<-x$dyads.pred #Get dyad probs dpm<-x$dyads.pred*dc #Get pred marginals dpsd<-sqrt(dp*(1-dp)*dc) #Get pred SD dr<-range(c(x$dyads,dpm+1.96*dpsd,dpm-1.96*dpsd)) #Get range if(all(x$dyads>0)&&(all(dpm>0))) plot(1:3,dpm,axes=FALSE,ylim=dr,main="Predicted Dyad Census", xlab="Dyad Type",ylab="Count",log="y",col=2,xlim=c(0.5,3.5)) else plot(1:3,dpm,axes=FALSE,ylim=dr,main="Predicted Dyad Census", xlab="Dyad Type",ylab="Count",col=2,xlim=c(0.5,3.5)) segments(1:3,dpm-1.96*dpsd,1:3,dpm+1.96*dpsd,col=2) segments(1:3-0.3,dpm-1.96*dpsd,1:3+0.3,dpm-1.96*dpsd,col=2) segments(1:3-0.3,dpm+1.96*dpsd,1:3+0.3,dpm+1.96*dpsd,col=2) points(1:3,x$dyads,pch=19) axis(2) axis(1,at=1:3,labels=names(x$dyads),las=3) #Triad plot tc<-sum(x$triads) #Get # triads tp<-x$triads.pred #Get triad probs tpm<-x$triads.pred*tc #Get pred marginals tpsd<-sqrt(tp*(1-tp)*tc) #Get pred SD tr<-range(c(x$triads,tpm+1.96*tpsd,tpm-1.96*tpsd)) #Get range if(all(x$triads>0)&&(all(tpm>0))) plot(1:16,tpm,axes=FALSE,ylim=tr,main="Predicted Triad Census", xlab="Triad Type",ylab="Count",log="y",col=2) else plot(1:16,tpm,axes=FALSE,ylim=tr,main="Predicted Triad Census", xlab="Triad Type",ylab="Count",col=2) segments(1:16,tpm-1.96*tpsd,1:16,tpm+1.96*tpsd,col=2) segments(1:16-0.3,tpm-1.96*tpsd,1:16+0.3,tpm-1.96*tpsd,col=2) segments(1:16-0.3,tpm+1.96*tpsd,1:16+0.3,tpm+1.96*tpsd,col=2) points(1:16,x$triads,pch=19) axis(2) axis(1,at=1:16,labels=names(x$triads),las=3) #Structure statistics ssr<-range(c(x$ss,x$ss.pred)) plot(0:(length(x$ss)-1),x$ss,type="b",xlab="Distance",ylab="Proportion Reached", main="Predicted Structure Statistics",ylim=ssr) lines(0:(length(x$ss)-1),x$ss.pred,col=2,lty=2) } #plot.lnam - Plot method for lnam plot.lnam<-function(x,...){ r<-residuals(x) f<-fitted(x) d<-x$disturbances sdr<-sd(r) ci<-c(-1.959964,1.959964) old.par <- par(no.readonly = TRUE) on.exit(par(old.par)) par(mfrow=c(2,2)) #Plot residual versus actual values plot(x$y,f,ylab=expression(hat(y)),xlab=expression(y),main="Fitted vs. Observed Values") abline(ci[1]*sdr,1,lty=3) abline(0,1,lty=2) abline(ci[2]*sdr,1,lty=3) #Plot disturbances versus fitted values plot(f,d,ylab=expression(hat(nu)),xlab=expression(hat(y)), ylim=c(min(ci[1]*x$sigma,d),max(ci[2]*x$sigma,d)),main="Fitted Values vs. Estimated Disturbances") abline(h=c(ci[1]*x$sigma,0,ci[2]*x$sigma),lty=c(3,2,3)) #QQ-Plot the residuals qqnorm(r,main="Normal Q-Q Residual Plot") qqline(r) #Plot an influence diagram if(!(is.null(x$W1)&&is.null(x$W2))){ inf<-matrix(0,ncol=x$df.total,nrow=x$df.total) if(!is.null(x$W1)) inf<-inf+qr.solve(diag(x$df.total)-apply(sweep(x$W1,1,x$rho1,"*"), c(2,3),sum)) if(!is.null(x$W2)) inf<-inf+qr.solve(diag(x$df.total)-apply(sweep(x$W2,1,x$rho2,"*"), c(2,3),sum)) syminf<-abs(inf)+abs(t(inf)) diag(syminf)<-0 infco<-cmdscale(as.dist(max(syminf)-syminf),k=2) diag(inf)<-NA stdinf<-inf-mean(inf,na.rm=TRUE) infsd<-sd(as.vector(stdinf),na.rm=TRUE) stdinf<-stdinf/infsd gplot(abs(stdinf),thresh=1.96,coord=infco,main="Net Influence Plot",edge.lty=1,edge.lwd=abs(stdinf)/2,edge.col=2+(inf>0)) } #Restore plot settings invisible() } #potscalered.mcmc - Potential scale reduction (sqrt(Rhat)) for scalar estimands. #Input must be a matrix whose columns correspond to replicate chains. This, #clearly, doesn't belong here, but lacking a better place to put it I have #included it nonetheless. potscalered.mcmc<-function(psi){ #Use Gelman et al. notation, for convenience J<-dim(psi)[2] n<-dim(psi)[1] #Find between-group variance estimate mpsij<-apply(psi,2,mean) mpsitot<-mean(mpsij) B<-(n/(J-1))*sum((mpsij-mpsitot)^2) #Find within-group variance estimate s2j<-apply(psi,2,var) W<-mean(s2j) #Calculate the (estimated) marginal posterior variance of the estimand varppsi<-((n-1)/n)*W+(1/n)*B #Return the potential scale reduction estimate sqrt(varppsi/W) } #print.bayes.factor - A fairly generic routine for printing bayes factors, here used for the bbnam routine. print.bayes.factor<-function(x,...){ tab<-x$int.lik rownames(tab)<-x$model.names colnames(tab)<-x$model.names cat("Log Bayes Factors by Model:\n\n(Diagonals indicate raw integrated log likelihood estimates.)\n\n") print(tab) cat("\n") } #print.bbnam - Print method for bbnam print.bbnam<-function(x,...){ UseMethod("print",x) } #print.bbnam.actor - Print method for bbnam.actor print.bbnam.actor<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Multiple Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") #Dump summary of error probabilities cat("Marginal Posterior Global Error Distribution:\n\n") d<-matrix(ncol=2,nrow=6) d[1:3,1]<-quantile(x$em,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,1]<-mean(x$em,na.rm=TRUE) d[5:6,1]<-quantile(x$em,c(0.75,1.0),names=FALSE,na.rm=TRUE) d[1:3,2]<-quantile(x$ep,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,2]<-mean(x$ep,na.rm=TRUE) d[5:6,2]<-quantile(x$ep,c(0.75,1.0),names=FALSE,na.rm=TRUE) colnames(d)<-c("e^-","e^+") rownames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") } #print.bbnam.fixed - Print method for bbnam.fixed print.bbnam.fixed<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Fixed Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") } #print.bbnam.pooled - Print method for bbnam.pooled print.bbnam.pooled<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Pooled Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") #Dump summary of error probabilities cat("Marginal Posterior Global Error Distribution:\n\n") d<-matrix(ncol=2,nrow=6) d[1:3,1]<-quantile(x$em,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,1]<-mean(x$em,na.rm=TRUE) d[5:6,1]<-quantile(x$em,c(0.75,1.0),names=FALSE,na.rm=TRUE) d[1:3,2]<-quantile(x$ep,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,2]<-mean(x$ep,na.rm=TRUE) d[5:6,2]<-quantile(x$ep,c(0.75,1.0),names=FALSE,na.rm=TRUE) colnames(d)<-c("e^-","e^+") rownames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") } #print.bn - Print method for summary.bn print.bn<-function(x, digits=max(4,getOption("digits")-3), ...){ cat("\nBiased Net Model\n\n") cat("Parameters:\n\n") cmat<-matrix(c(x$d,x$pi,x$sigma,x$rho),ncol=1) colnames(cmat)<-"Estimate" rownames(cmat)<-c("d","pi","sigma","rho") printCoefmat(cmat,digits=digits,...) cat("\n") } #print.lnam - Print method for lnam print.lnam<-function(x, digits = max(3, getOption("digits") - 3), ...){ cat("\nCall:\n", deparse(x$call), "\n\n", sep = "") cat("Coefficients:\n") print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE) cat("\n") } #print.netcancor - Print method for netcancor print.netcancor<-function(x,...){ cat("\nCanonical Network Correlation\n\n") cat("Canonical Correlations:\n\n") cmat<-matrix(data=x$cor,ncol=length(x$cor),nrow=1) rownames(cmat)<-"" colnames(cmat)<-as.vector(x$cnames) print.table(cmat) cat("\n") cat("Pr(>=cor):\n\n") cmat <- matrix(data=format(x$cpgreq),ncol=length(x$cpgreq),nrow=1) colnames(cmat) <- as.vector(x$cnames) rownames(cmat)<- "" print.table(cmat) cat("\n") cat("Pr(<=cor):\n\n") cmat <- matrix(data=format(x$cpleeq),ncol=length(x$cpleeq),nrow=1) colnames(cmat) <- as.vector(x$cnames) rownames(cmat)<- "" print.table(cmat) cat("\n") cat("X Coefficients:\n\n") cmat <- format(x$xcoef) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Pr(>=xcoef):\n\n") cmat <- format(x$xpgreq) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Pr(<=xcoef):\n\n") cmat <- format(x$xpleeq) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Y Coefficients:\n\n") cmat <- format(x$ycoef) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") cat("Pr(>=ycoef):\n\n") cmat <- format(x$ypgreq) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") cat("Pr(<=ycoef):\n\n") cmat <- format(x$ypleeq) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") } #print.netlm - Print method for netlm print.netlm<-function(x,...){ cat("\nOLS Network Model\n\n") cat("Coefficients:\n") cmat <- as.vector(format(as.numeric(x$coefficients))) cmat <- cbind(cmat, as.vector(format(x$pleeq))) cmat <- cbind(cmat, as.vector(format(x$pgreq))) cmat <- cbind(cmat, as.vector(format(x$pgreqabs))) colnames(cmat) <- c("Estimate", "Pr(<=b)", "Pr(>=b)","Pr(>=|b|)") rownames(cmat)<- as.vector(x$names) print.table(cmat) #Goodness of fit measures mss<-if(x$intercept) sum((fitted(x)-mean(fitted(x)))^2) else sum(fitted(x)^2) rss<-sum(resid(x)^2) qn<-NROW(x$qr$qr) df.int<-x$intercept rdf<-qn-x$rank resvar<-rss/rdf fstatistic<-c(value=(mss/(x$rank-df.int))/resvar,numdf=x$rank-df.int, dendf=rdf) r.squared<-mss/(mss+rss) adj.r.squared<-1-(1-r.squared)*((qn-df.int)/rdf) sigma<-sqrt(resvar) cat("\nResidual standard error:",format(sigma,digits=4),"on",rdf,"degrees of freedom\n") cat("F-statistic:",formatC(fstatistic[1],digits=4),"on",fstatistic[2],"and", fstatistic[3],"degrees of freedom, p-value:",formatC(1-pf(fstatistic[1],fstatistic[2],fstatistic[3]),digits=4),"\n") cat("Multiple R-squared:",format(r.squared,digits=4),"\t") cat("Adjusted R-squared:",format(adj.r.squared,digits=4),"\n") cat("\n") } #print.netlogit - Print method for netlogit print.netlogit<-function(x,...){ cat("\nNetwork Logit Model\n\n") cat("Coefficients:\n") cmat <- as.vector(format(as.numeric(x$coefficients))) cmat <- cbind(cmat, as.vector(format(exp(as.numeric(x$coefficients))))) cmat <- cbind(cmat, as.vector(format(x$pleeq))) cmat <- cbind(cmat, as.vector(format(x$pgreq))) cmat <- cbind(cmat, as.vector(format(x$pgreqabs))) colnames(cmat) <- c("Estimate", "Exp(b)", "Pr(<=b)", "Pr(>=b)", "Pr(>=|b|)") rownames(cmat)<- as.vector(x$names) print.table(cmat) cat("\nGoodness of Fit Statistics:\n") cat("\nNull deviance:",x$null.deviance,"on",x$df.null,"degrees of freedom\n") cat("Residual deviance:",x$deviance,"on",x$df.residual,"degrees of freedom\n") cat("Chi-Squared test of fit improvement:\n\t",x$null.deviance-x$deviance,"on",x$df.null-x$df.residual,"degrees of freedom, p-value",1-pchisq(x$null.deviance-x$deviance,df=x$df.null-x$df.residual),"\n") cat("AIC:",x$aic,"\tBIC:",x$bic,"\nPseudo-R^2 Measures:\n\t(Dn-Dr)/(Dn-Dr+dfn):",(x$null.deviance-x$deviance)/(x$null.deviance-x$deviance+x$df.null),"\n\t(Dn-Dr)/Dn:",1-x$deviance/x$null.deviance,"\n") cat("\n") } #print.summary.bayes.factor - Printing for bayes factor summary objects print.summary.bayes.factor<-function(x,...){ cat("Log Bayes Factors by Model:\n\n(Diagonals indicate raw integrated log likelihood estimates.)\n\n") print(x$int.lik) stdtab<-matrix(x$int.lik.std,nrow=1) colnames(stdtab)<-x$model.names cat("\n\nLog Inverse Bayes Factors:\n\n(Diagonals indicate log posterior probability of model under within-set choice constraints and uniform model priors.\n\n") print(x$inv.bf) cat("\nEstimated model probabilities (within-set):\n") temp<-exp(diag(x$inv.bf)) names(temp)<-x$model.names print(temp) cat("\n\nDiagnostics:\n\nReplications - ",x$reps,"\n\nLog std deviations of integrated likelihood estimates:\n") names(x$int.lik.std)<-x$model.names print(x$int.lik.std) cat("\n\nVector of hyperprior parameters:\n\n") priortab<-matrix(x$prior.param,nrow=1,ncol=length(x$prior.param)) colnames(priortab)<-x$prior.param.names print(priortab) cat("\n\n") } #print.summary.bbnam - Print method for summary.bbnam print.summary.bbnam<-function(x,...){ UseMethod("print",x) } #print.summary.bbnam.actor - Print method for summary.bbnam.actor print.summary.bbnam.actor<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Multiple Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") #Dump summary of error probabilities cat("Marginal Posterior Global Error Distribution:\n\n") d<-matrix(ncol=2,nrow=6) d[1:3,1]<-quantile(x$em,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,1]<-mean(x$em,na.rm=TRUE) d[5:6,1]<-quantile(x$em,c(0.75,1.0),names=FALSE,na.rm=TRUE) d[1:3,2]<-quantile(x$ep,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,2]<-mean(x$ep,na.rm=TRUE) d[5:6,2]<-quantile(x$ep,c(0.75,1.0),names=FALSE,na.rm=TRUE) colnames(d)<-c("e^-","e^+") rownames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") #Dump error probability estimates per observer cat("Marginal Posterior Error Distribution (by observer):\n\n") cat("Probability of False Negatives (e^-):\n\n") d<-matrix(ncol=6) for(i in 1:x$nobservers){ dv<-matrix(c(quantile(x$em[,i],c(0,0.25,0.5),names=FALSE,na.rm=TRUE),mean(x$em[,i],na.rm=TRUE),quantile(x$em[,i],c(0.75,1.0),names=FALSE,na.rm=TRUE)),nrow=1,ncol=6) d<-rbind(d,dv) } d<-d[2:(x$nobservers+1),] rownames(d)<-as.vector(x$onames) colnames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") cat("Probability of False Positives (e^+):\n\n") d<-matrix(ncol=6) for(i in 1:x$nobservers){ dv<-matrix(c(quantile(x$ep[,i],c(0,0.25,0.5),names=FALSE,na.rm=TRUE),mean(x$ep[,i],na.rm=TRUE),quantile(x$ep[,i],c(0.75,1.0),names=FALSE,na.rm=TRUE)),nrow=1,ncol=6) d<-rbind(d,dv) } d<-d[2:(x$nobservers+1),] rownames(d)<-as.vector(x$onames) colnames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") #Dump MCMC diagnostics cat("MCMC Diagnostics:\n\n") cat("\tReplicate Chains:",x$reps,"\n") cat("\tBurn Time:",x$burntime,"\n") cat("\tDraws per Chain:",x$draws/x$reps,"Total Draws:",x$draws,"\n") if("sqrtrhat" %in% names(x)) cat("\tPotential Scale Reduction (G&R's sqrt(Rhat)):\n \t\tMax:",max(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n\t\tMed:",median(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n\t\tIQR:",IQR(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n") cat("\n") } #print.summary.bbnam.fixed - Print method for summary.bbnam.fixed print.summary.bbnam.fixed<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Fixed Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") #Dump model diagnostics cat("Model Diagnostics:\n\n") cat("\tTotal Draws:",x$draws,"\n\t(Note: Draws taken directly from network posterior.)") cat("\n") } #print.summary.bbnam.pooled - Print method for summary.bbnam.pooled print.summary.bbnam.pooled<-function(x,...){ cat("\nButts' Hierarchical Bayes Model for Network Estimation/Informant Accuracy\n\n") cat("Pooled Error Probability Model\n\n") #Dump marginal posterior network cat("Marginal Posterior Network Distribution:\n\n") d<-apply(x$net,c(2,3),mean) rownames(d)<-as.vector(x$anames) colnames(d)<-as.vector(x$anames) print.table(d,digits=2) cat("\n") #Dump summary of error probabilities cat("Marginal Posterior Error Distribution:\n\n") d<-matrix(ncol=2,nrow=6) d[1:3,1]<-quantile(x$em,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,1]<-mean(x$em,na.rm=TRUE) d[5:6,1]<-quantile(x$em,c(0.75,1.0),names=FALSE,na.rm=TRUE) d[1:3,2]<-quantile(x$ep,c(0,0.25,0.5),names=FALSE,na.rm=TRUE) d[4,2]<-mean(x$ep,na.rm=TRUE) d[5:6,2]<-quantile(x$ep,c(0.75,1.0),names=FALSE,na.rm=TRUE) colnames(d)<-c("e^-","e^+") rownames(d)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(d,digits=4) cat("\n") #Dump MCMC diagnostics cat("MCMC Diagnostics:\n\n") cat("\tReplicate Chains:",x$reps,"\n") cat("\tBurn Time:",x$burntime,"\n") cat("\tDraws per Chain:",x$draws/x$reps,"Total Draws:",x$draws,"\n") if("sqrtrhat" %in% names(x)) cat("\tPotential Scale Reduction (G&R's sqrt(Rhat)):\n \t\tMax:",max(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n\t\tMed:",median(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n\t\tIQR:",IQR(x$sqrtrhat[!is.nan(x$sqrtrhat)]),"\n") cat("\n") } #print.summary.bn - Print method for summary.bn print.summary.bn<-function(x, digits=max(4,getOption("digits")-3), signif.stars=getOption("show.signif.stars"), ...){ cat("\nBiased Net Model\n\n") cat("\nParameters:\n\n") cmat<-matrix(c(x$d,x$pi,x$sigma,x$rho),ncol=1) colnames(cmat)<-"Estimate" rownames(cmat)<-c("d","pi","sigma","rho") printCoefmat(cmat,digits=digits,...) #Diagnostics cat("\nDiagnostics:\n\n") cat("\tFit method:",x$method,"\n") cat("\tPseudolikelihood G^2:",x$G.square,"\n") #Plot edge census cat("\n\tEdge census comparison:\n\n") ec<-sum(x$edges) cmat<-cbind(x$edges,x$edges.pred*ec) cmat<-cbind(cmat,(cmat[,1]-cmat[,2])/sqrt(x$edges.pred*(1-x$edges.pred)*ec)) cmat<-cbind(cmat,2*(1-pnorm(abs(cmat[,3])))) colnames(cmat)<-c("Observed","Predicted","Z Value","Pr(>|z|)") printCoefmat(cmat,digits=digits,signif.stars=signif.stars,...) chisq<-sum((cmat[,1]-cmat[,2])^2/cmat[,2]) cat("\tChi-Square:",chisq,"on 1 degrees of freedom. p-value:",1-pchisq(chisq,1),"\n\n") #Plot dyad census cat("\n\tDyad census comparison:\n\n") dc<-sum(x$dyads) cmat<-cbind(x$dyads,x$dyads.pred*dc) cmat<-cbind(cmat,(cmat[,1]-cmat[,2])/sqrt(x$dyads.pred*(1-x$dyads.pred)*dc)) cmat<-cbind(cmat,2*(1-pnorm(abs(cmat[,3])))) colnames(cmat)<-c("Observed","Predicted","Z Value","Pr(>|z|)") printCoefmat(cmat,digits=digits,signif.stars=signif.stars,...) chisq<-sum((cmat[,1]-cmat[,2])^2/cmat[,2]) cat("\tChi-Square:",chisq,"on 2 degrees of freedom. p-value:",1-pchisq(chisq,2),"\n\n") #Plot triad census cat("\n\tTriad census comparison:\n\n") tc<-sum(x$triads) cmat<-cbind(x$triads,x$triads.pred*tc) cmat<-cbind(cmat,(cmat[,1]-cmat[,2])/sqrt(x$triads.pred*(1-x$triads.pred)*tc)) cmat<-cbind(cmat,2*(1-pnorm(abs(cmat[,3])))) colnames(cmat)<-c("Observed","Predicted","Z Value","Pr(>|z|)") printCoefmat(cmat,digits=digits,signif.stars=signif.stars,...) chisq<-sum((cmat[,1]-cmat[,2])^2/cmat[,2]) cat("\tChi-Square:",chisq,"on 15 degrees of freedom. p-value:",1-pchisq(chisq,15),"\n\n") } #print.summary.brokerage - print method for summary.brokerage objects print.summary.brokerage<-function(x,...){ cat("Gould-Fernandez Brokerage Analysis\n\n") cat("Global Brokerage Properties\n") cmat<-cbind(x$raw.gli,x$exp.gli,x$sd.gli,x$z.gli,2*(1-pnorm(abs(x$z.gli)))) rownames(cmat)<-names(x$raw.gli) colnames(cmat)<-c("t","E(t)","Sd(t)","z","Pr(>|z|)") printCoefmat(cmat) cat("\nIndividual Properties (by Group)\n") for(i in x$clid){ cat("\n\tGroup ID:",i,"\n") temp<-x$cl==i cmat<-cbind(x$raw.nli,x$z.nli)[temp,,drop=FALSE] print(cmat) } cat("\n") } #print.summary.lnam - Print method for summary.lnam print.summary.lnam<-function(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...){ cat("\nCall:\n") cat(paste(deparse(x$call), sep = "\n", collapse = "\n"), "\n\n", sep = "") cat("Residuals:\n") nam <- c("Min", "1Q", "Median", "3Q", "Max") resid<-x$residuals rq <- if (length(dim(resid)) == 2) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else structure(quantile(resid), names = nam) print(rq, digits = digits, ...) cat("\nCoefficients:\n") cmat<-cbind(coef(x),se.lnam(x)) cmat<-cbind(cmat,cmat[,1]/cmat[,2],(1-pnorm(abs(cmat[,1]),0,cmat[,2]))*2) colnames(cmat)<-c("Estimate","Std. Error","Z value","Pr(>|z|)") #print(format(cmat,digits=digits),quote=FALSE) printCoefmat(cmat,digits=digits,signif.stars=signif.stars,...) cat("\n") cmat<-cbind(x$sigma,x$sigma.se) colnames(cmat)<-c("Estimate","Std. Error") rownames(cmat)<-"Sigma" printCoefmat(cmat,digits=digits,signif.stars=signif.stars,...) cat("\nGoodness-of-Fit:\n") rss<-sum(x$residuals^2) mss<-sum((x$fitted-mean(x$fitted))^2) rdfns<-x$df.residual+1 cat("\tResidual standard error: ",format(sqrt(rss/rdfns),digits=digits)," on ",rdfns," degrees of freedom (w/o Sigma)\n",sep="") cat("\tMultiple R-Squared: ",format(mss/(mss+rss),digits=digits),", Adjusted R-Squared: ",format(1-(1-mss/(mss+rss))*x$df.total/rdfns,digits=digits),"\n",sep="") cat("\tModel log likelihood:", format(x$lnlik.model,digits=digits), "on", x$df.resid, "degrees of freedom (w/Sigma)\n\tAIC:",format(-2*x$lnlik.model+2*x$df.model,digits=digits),"BIC:",format(-2*x$lnlik.model+log(x$df.total)*x$df.model,digits=digits),"\n") cat("\n\tNull model:",x$null.model,"\n") cat("\tNull log likelihood:", format(x$lnlik.null,digits=digits), "on", x$df.null.resid, "degrees of freedom\n\tAIC:",format(-2*x$lnlik.null+2*x$df.null,digits=digits),"BIC:",format(-2*x$lnlik.null+log(x$df.total)*x$df.null,digits=digits),"\n") cat("\tAIC difference (model versus null):",format(-2*x$lnlik.null+2*x$df.null+2*x$lnlik.model-2*x$df.model,digits=digits),"\n") cat("\tHeuristic Log Bayes Factor (model versus null): ",format(-2*x$lnlik.null+log(x$df.total)*x$df.null+2*x$lnlik.model-log(x$df.total)*x$df.model,digits=digits),"\n") cat("\n") } #print.summary.netcancor - Print method for summary.netcancor print.summary.netcancor<-function(x,...){ cat("\nCanonical Network Correlation\n\n") cat("Canonical Correlations:\n\n") cmat<-as.vector(x$cor) cmat<-rbind(cmat,as.vector((x$cor)^2)) rownames(cmat)<-c("Correlation","Coef. of Det.") colnames(cmat)<-as.vector(x$cnames) print.table(cmat) cat("\n") cat("Pr(>=cor):\n\n") cmat <- matrix(data=format(x$cpgreq),ncol=length(x$cpgreq),nrow=1) colnames(cmat) <- as.vector(x$cnames) rownames(cmat)<- "" print.table(cmat) cat("\n") cat("Pr(<=cor):\n\n") cmat <- matrix(data=format(x$cpleeq),ncol=length(x$cpleeq),nrow=1) colnames(cmat) <- as.vector(x$cnames) rownames(cmat)<- "" print.table(cmat) cat("\n") cat("X Coefficients:\n\n") cmat <- format(x$xcoef) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Pr(>=xcoef):\n\n") cmat <- format(x$xpgreq) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Pr(<=xcoef):\n\n") cmat <- format(x$xpleeq) colnames(cmat) <- as.vector(x$xnames) rownames(cmat)<- as.vector(x$xnames) print.table(cmat) cat("\n") cat("Y Coefficients:\n\n") cmat <- format(x$ycoef) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") cat("Pr(>=ycoef):\n\n") cmat <- format(x$ypgreq) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") cat("Pr(<=ycoef):\n\n") cmat <- format(x$ypleeq) colnames(cmat) <- as.vector(x$ynames) rownames(cmat)<- as.vector(x$ynames) print.table(cmat) cat("\n") cat("Test Diagnostics:\n\n") cat("\tNull Hypothesis:") if(x$nullhyp=="qap") cat(" QAP\n") else cat(" CUG\n") cat("\tReplications:",dim(x$cdist)[1],"\n") cat("\tDistribution Summary for Correlations:\n\n") dmat<-apply(x$cdist,2,min,na.rm=TRUE) dmat<-rbind(dmat,apply(x$cdist,2,quantile,probs=0.25,names=FALSE,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$cdist,2,quantile,probs=0.5,names=FALSE,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$cdist,2,mean,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$cdist,2,quantile,probs=0.75,names=FALSE,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$cdist,2,max,na.rm=TRUE)) colnames(dmat)<-as.vector(x$cnames) rownames(dmat)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(dmat,digits=4) cat("\n") } #print.summary.netlm - Print method for summary.netlm print.summary.netlm<-function(x,...){ cat("\nOLS Network Model\n\n") #Residuals cat("Residuals:\n") print.table(format(quantile(x$residuals))) #Coefficients cat("\nCoefficients:\n") cmat <- as.vector(format(as.numeric(x$coefficients))) cmat <- cbind(cmat, as.vector(format(x$pleeq))) cmat <- cbind(cmat, as.vector(format(x$pgreq))) cmat <- cbind(cmat, as.vector(format(x$pgreqabs))) colnames(cmat) <- c("Estimate", "Pr(<=b)", "Pr(>=b)", "Pr(>=|b|)") rownames(cmat)<- as.vector(x$names) print.table(cmat) #Goodness of fit measures mss<-if(x$intercept) sum((fitted(x)-mean(fitted(x)))^2) else sum(fitted(x)^2) rss<-sum(resid(x)^2) qn<-NROW(x$qr$qr) df.int<-x$intercept rdf<-qn-x$rank resvar<-rss/rdf fstatistic<-c(value=(mss/(x$rank-df.int))/resvar,numdf=x$rank-df.int, dendf=rdf) r.squared<-mss/(mss+rss) adj.r.squared<-1-(1-r.squared)*((qn-df.int)/rdf) sigma<-sqrt(resvar) cat("\nResidual standard error:",format(sigma,digits=4),"on",rdf,"degrees of freedom\n") cat("Multiple R-squared:",format(r.squared,digits=4),"\t") cat("Adjusted R-squared:",format(adj.r.squared,digits=4),"\n") cat("F-statistic:",formatC(fstatistic[1],digits=4),"on",fstatistic[2],"and", fstatistic[3],"degrees of freedom, p-value:",formatC(1-pf(fstatistic[1],fstatistic[2],fstatistic[3]),digits=4),"\n") #Test diagnostics cat("\n\nTest Diagnostics:\n\n") cat("\tNull Hypothesis:",x$nullhyp,"\n") if(!is.null(x$dist)){ cat("\tReplications:",dim(x$dist)[1],"\n") cat("\tCoefficient Distribution Summary:\n\n") dmat<-apply(x$dist,2,min,na.rm=TRUE) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.25,names=FALSE, na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.5,names=FALSE,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,mean,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.75,names=FALSE, na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,max,na.rm=TRUE)) colnames(dmat)<-as.vector(x$names) rownames(dmat)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(dmat,digits=4) cat("\n") } } #print.summary.netlogit - Print method for summary.netlogit print.summary.netlogit<-function(x,...){ cat("\nNetwork Logit Model\n\n") cat("Coefficients:\n") cmat <- as.vector(format(as.numeric(x$coefficients))) cmat <- cbind(cmat, as.vector(format(exp(as.numeric(x$coefficients))))) cmat <- cbind(cmat, as.vector(format(x$pleeq))) cmat <- cbind(cmat, as.vector(format(x$pgreq))) cmat <- cbind(cmat, as.vector(format(x$pgreqabs))) colnames(cmat) <- c("Estimate", "Exp(b)", "Pr(<=b)", "Pr(>=b)", "Pr(>=|b|)") rownames(cmat)<- as.vector(x$names) print.table(cmat) cat("\nGoodness of Fit Statistics:\n") cat("\nNull deviance:",x$null.deviance,"on",x$df.null,"degrees of freedom\n") cat("Residual deviance:",x$deviance,"on",x$df.residual,"degrees of freedom\n") cat("Chi-Squared test of fit improvement:\n\t",x$null.deviance-x$deviance,"on",x$df.null-x$df.residual,"degrees of freedom, p-value",1-pchisq(x$null.deviance-x$deviance,df=x$df.null-x$df.residual),"\n") cat("AIC:",x$aic,"\tBIC:",x$bic,"\nPseudo-R^2 Measures:\n\t(Dn-Dr)/(Dn-Dr+dfn):",(x$null.deviance-x$deviance)/(x$null.deviance-x$deviance+x$df.null),"\n\t(Dn-Dr)/Dn:",1-x$deviance/x$null.deviance,"\n") cat("Contingency Table (predicted (rows) x actual (cols)):\n\n") print.table(x$ctable,print.gap=3) cat("\n\tTotal Fraction Correct:",(x$ctable[1,1]+x$ctable[2,2])/sum(x$ctable),"\n\tFraction Predicted 1s Correct:",x$ctable[2,2]/sum(x$ctable[2,]),"\n\tFraction Predicted 0s Correct:",x$ctable[1,1]/sum(x$ctable[1,]),"\n") cat("\tFalse Negative Rate:",x$ctable[1,2]/sum(x$ctable[,2]),"\n") cat("\tFalse Positive Rate:",x$ctable[2,1]/sum(x$ctable[,1]),"\n") cat("\nTest Diagnostics:\n\n") cat("\tNull Hypothesis:",x$nullhyp,"\n") if(!is.null(x$dist)){ cat("\tReplications:",dim(x$dist)[1],"\n") cat("\tDistribution Summary:\n\n") dmat<-apply(x$dist,2,min,na.rm=TRUE) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.25,names=FALSE, na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.5,names=FALSE,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,mean,na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,quantile,probs=0.75,names=FALSE, na.rm=TRUE)) dmat<-rbind(dmat,apply(x$dist,2,max,na.rm=TRUE)) colnames(dmat)<-as.vector(x$names) rownames(dmat)<-c("Min","1stQ","Median","Mean","3rdQ","Max") print.table(dmat,digits=4) cat("\n") } } #pstar - Perform an approximate p* analysis using the logistic regression #approximation. Note that the result of this is returned as a GLM object, and #subsequent printing/summarizing/etc. should be treated accordingly. pstar<-function(dat,effects=c("choice","mutuality","density","reciprocity","stransitivity","wtransitivity","stranstri","wtranstri","outdegree","indegree","betweenness","closeness","degcentralization","betcentralization","clocentralization","connectedness","hierarchy","lubness","efficiency"),attr=NULL,memb=NULL,diag=FALSE,mode="digraph"){ #First, take care of various details dat<-as.sociomatrix.sna(dat) if(is.list(dat)||(is.array(dat)&&(length(dim(dat))>2))) stop("Single graphs required in pstar.") n<-dim(dat)[1] m<-dim(dat)[2] o<-list() #Next, add NAs as needed d<-dat if(!diag) d<-diag.remove(d) if(mode=="graph") d<-upper.tri.remove(d) #Make sure that attr and memb are well-behaved if(!is.null(attr)){ if(is.vector(attr)) attr<-matrix(attr,ncol=1) if(is.null(colnames(attr))) colnames(attr)<-paste("Attribute",1:dim(attr)[2],sep=".") } if(!is.null(memb)){ if(is.vector(memb)) memb<-matrix(memb,ncol=1) if(is.null(colnames(memb))) colnames(memb)<-paste("Membership",1:dim(memb)[2],sep=".") } #Now, evaluate each specified effect given each possible perturbation tiedat<-vector() for(i in 1:n) for(j in 1:m) if(!is.na(d[i,j])){ #Assess the effects td<-vector() if(!is.na(pmatch("choice",effects))){ #Compute a choice effect td<-c(td,1) #Always constant } if(!is.na(pmatch("mutuality",effects))){ #Compute a mutuality effect td<-c(td,eval.edgeperturbation(d,i,j,"mutuality")) } if(!is.na(pmatch("density",effects))){ #Compute a density effect td<-c(td,eval.edgeperturbation(d,i,j,"gden",mode=mode,diag=diag)) } if(!is.na(pmatch("reciprocity",effects))){ #Compute a reciprocity effect td<-c(td,eval.edgeperturbation(d,i,j,"grecip")) } if(!is.na(pmatch("stransitivity",effects))){ #Compute a strong transitivity effect td<-c(td,eval.edgeperturbation(d,i,j,"gtrans",mode=mode,diag=diag,measure="strong")) } if(!is.na(pmatch("wtransitivity",effects))){ #Compute a weak transitivity effect td<-c(td,eval.edgeperturbation(d,i,j,"gtrans",mode=mode,diag=diag,measure="weak")) } if(!is.na(pmatch("stranstri",effects))){ #Compute a strong trans census effect td<-c(td,eval.edgeperturbation(d,i,j,"gtrans",mode=mode,diag=diag,measure="strongcensus")) } if(!is.na(pmatch("wtranstri",effects))){ #Compute a weak trans census effect td<-c(td,eval.edgeperturbation(d,i,j,"gtrans",mode=mode,diag=diag,measure="weakcensus")) } if(!is.na(pmatch("outdegree",effects))){ #Compute outdegree effects td<-c(td,eval.edgeperturbation(d,i,j,"degree",cmode="outdegree",gmode=mode,diag=diag)) } if(!is.na(pmatch("indegree",effects))){ #Compute indegree effects td<-c(td,eval.edgeperturbation(d,i,j,"degree",cmode="indegree",gmode=mode,diag=diag)) } if(!is.na(pmatch("betweenness",effects))){ #Compute betweenness effects td<-c(td,eval.edgeperturbation(d,i,j,"betweenness",gmode=mode,diag=diag)) } if(!is.na(pmatch("closeness",effects))){ #Compute closeness effects td<-c(td,eval.edgeperturbation(d,i,j,"closeness",gmode=mode,diag=diag)) } if(!is.na(pmatch("degcentralization",effects))){ #Compute degree centralization effects td<-c(td,eval.edgeperturbation(d,i,j,"centralization","degree",mode=mode,diag=diag)) } if(!is.na(pmatch("betcentralization",effects))){ #Compute betweenness centralization effects td<-c(td,eval.edgeperturbation(d,i,j,"centralization","betweenness",mode=mode,diag=diag)) } if(!is.na(pmatch("clocentralization",effects))){ #Compute closeness centralization effects td<-c(td,eval.edgeperturbation(d,i,j,"centralization","closeness",mode=mode,diag=diag)) } if(!is.na(pmatch("connectedness",effects))){ #Compute connectedness effects td<-c(td,eval.edgeperturbation(d,i,j,"connectedness")) } if(!is.na(pmatch("hierarchy",effects))){ #Compute hierarchy effects td<-c(td,eval.edgeperturbation(d,i,j,"hierarchy")) } if(!is.na(pmatch("lubness",effects))){ #Compute lubness effects td<-c(td,eval.edgeperturbation(d,i,j,"lubness")) } if(!is.na(pmatch("efficiency",effects))){ #Compute efficiency effects td<-c(td,eval.edgeperturbation(d,i,j,"efficiency",diag=diag)) } #Add attribute differences, if needed if(!is.null(attr)) td<-c(td,abs(attr[i,]-attr[j,])) #Add membership similarities, if needed if(!is.null(memb)) td<-c(td,as.numeric(memb[i,]==memb[j,])) #Add this data to the aggregated tie data tiedat<-rbind(tiedat,c(d[i,j],td)) } #Label the tie data matrix tiedat.lab<-"EdgeVal" if(!is.na(pmatch("choice",effects))) #Label the choice effect tiedat.lab<-c(tiedat.lab,"Choice") if(!is.na(pmatch("mutuality",effects))) #Label the mutuality effect tiedat.lab<-c(tiedat.lab,"Mutuality") if(!is.na(pmatch("density",effects))) #Label the density effect tiedat.lab<-c(tiedat.lab,"Density") if(!is.na(pmatch("reciprocity",effects))) #Label the reciprocity effect tiedat.lab<-c(tiedat.lab,"Reciprocity") if(!is.na(pmatch("stransitivity",effects))) #Label the strans effect tiedat.lab<-c(tiedat.lab,"STransitivity") if(!is.na(pmatch("wtransitivity",effects))) #Label the wtrans effect tiedat.lab<-c(tiedat.lab,"WTransitivity") if(!is.na(pmatch("stranstri",effects))) #Label the stranstri effect tiedat.lab<-c(tiedat.lab,"STransTriads") if(!is.na(pmatch("wtranstri",effects))) #Label the wtranstri effect tiedat.lab<-c(tiedat.lab,"WTransTriads") if(!is.na(pmatch("outdegree",effects))) #Label the outdegree effect tiedat.lab<-c(tiedat.lab,paste("Outdegree",1:n,sep=".")) if(!is.na(pmatch("indegree",effects))) #Label the indegree effect tiedat.lab<-c(tiedat.lab,paste("Indegree",1:n,sep=".")) if(!is.na(pmatch("betweenness",effects))) #Label the betweenness effect tiedat.lab<-c(tiedat.lab,paste("Betweenness",1:n,sep=".")) if(!is.na(pmatch("closeness",effects))) #Label the closeness effect tiedat.lab<-c(tiedat.lab,paste("Closeness",1:n,sep=".")) if(!is.na(pmatch("degcent",effects))) #Label the degree centralization effect tiedat.lab<-c(tiedat.lab,"DegCentralization") if(!is.na(pmatch("betcent",effects))) #Label the betweenness centralization effect tiedat.lab<-c(tiedat.lab,"BetCentralization") if(!is.na(pmatch("clocent",effects))) #Label the closeness centralization effect tiedat.lab<-c(tiedat.lab,"CloCentralization") if(!is.na(pmatch("connectedness",effects))) #Label the connectedness effect tiedat.lab<-c(tiedat.lab,"Connectedness") if(!is.na(pmatch("hierarchy",effects))) #Label the hierarchy effect tiedat.lab<-c(tiedat.lab,"Hierarchy") if(!is.na(pmatch("lubness",effects))) #Label the lubness effect tiedat.lab<-c(tiedat.lab,"LUBness") if(!is.na(pmatch("efficiency",effects))) #Label the efficiency effect tiedat.lab<-c(tiedat.lab,"Efficiency") if(!is.null(attr)) tiedat.lab<-c(tiedat.lab,colnames(attr)) if(!is.null(memb)) tiedat.lab<-c(tiedat.lab,colnames(memb)) colnames(tiedat)<-tiedat.lab #Having had our fun, it's time to get serious. Run a GLM on the resulting data. fmla<-as.formula(paste("EdgeVal ~ -1 + ",paste(colnames(tiedat)[2:dim(tiedat)[2]],collapse=" + "))) o<-glm(fmla,family="binomial",data=as.data.frame(tiedat)) o$tiedata<-tiedat #Return the result o } #se.lnam - Standard error method for lnam se.lnam<-function(object, ...){ se<-vector() sen<-vector() if(!is.null(object$beta.se)){ se<-c(se,object$beta.se) sen<-c(sen,names(object$beta.se)) } if(!is.null(object$rho1.se)){ se<-c(se,object$rho1.se) sen<-c(sen,"rho1") } if(!is.null(object$rho2.se)){ se<-c(se,object$rho2.se) sen<-c(sen,"rho2") } names(se)<-sen se } #summary.bayes.factor - A fairly generic summary routine for bayes factors. #Clearly, this belongs in some other library than sna, but for the moment this #will have to do... summary.bayes.factor<-function(object, ...){ o<-object rownames(o$int.lik)<-o$model.names colnames(o$int.lik)<-o$model.names o$inv.bf<--o$int.lik for(i in 1:dim(o$int.lik)[1]) o$inv.bf[i,i]<-o$int.lik[i,i]-logSum(diag(o$int.lik)) class(o)<-c("summary.bayes.factor","bayes.factor") o } #summary.bbnam - Summary method for bbnam summary.bbnam<-function(object, ...){ out<-object class(out)<-c("summary.bbnam",class(out)) out } #summary.bbnam.actor - Summary method for bbnam.actor summary.bbnam.actor<-function(object, ...){ out<-object class(out)<-c("summary.bbnam.actor",class(out)) out } #summary.bbnam.fixed - Summary method for bbnam.fixed summary.bbnam.fixed<-function(object, ...){ out<-object class(out)<-c("summary.bbnam.fixed",class(out)) out } #summary.bbnam.pooled - Summary method for bbnam.pooled summary.bbnam.pooled<-function(object, ...){ out<-object class(out)<-c("summary.bbnam.pooled",class(out)) out } #summary.bn - Summary method for bn summary.bn<-function(object, ...){ out<-object class(out)<-c("summary.bn",class(out)) out } #summary.brokerage - Summary method for brokerage objects summary.brokerage<-function(object,...){ class(object)<-"summary.brokerage" object } #summary.lnam - Summary method lnam summary.lnam<-function(object, ...){ ans<-object class(ans)<-c("summary.lnam","lnam") ans } #summary.netcancor - Summary method for netcancor summary.netcancor<-function(object, ...){ out<-object class(out)<-c("summary.netcancor",class(out)) out } #summary.netlm - Summary method for netlm summary.netlm<-function(object, ...){ out<-object class(out)<-c("summary.netlm",class(out)) out } #summary.netlogit - Summary method for netlogit summary.netlogit<-function(object, ...){ out<-object class(out)<-c("summary.netlogit",class(out)) out } sna/R/fileio.R0000644000176200001440000001105614533477546012653 0ustar liggesusers###################################################################### # # fileio.R # # copyright (c) 2004, Carter T. Butts # Last Modified 12/4/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines relating to file I/O. # # Contents: # read.dot # read.nos # write.dl # write.nos # ###################################################################### #read.dot - Import a file in Graphviz .dot format. This code was contributed #by Matthijs den Besten. read.dot <- function(...) { lines <- readLines(...); body <- lines[grep("->", lines, fixed=TRUE)]; nodePairs <- sub('^[[:space:]]+\"', '\"', sub('\"[;[:space:]]+$', '\"', unlist(strsplit(body, "->")))); nodeLists <- split(nodePairs,1:length(nodePairs)%%2); nodes <- unique(nodePairs); edges <- data.frame(orig=nodeLists[[2]], dest=nodeLists[[1]]); n <- length(nodes); graph <- matrix(0, n, n, dimnames=list(nodes, nodes)); #for(i in 1:nrow(edges)) { # edge <- edges[i,]; # graph[edge$orig,edge$dest] <- 1; #} // Did not work as intended. for(node in nodes) { graph[node,nodes%in%edges$dest[edges$orig==node]] <- 1; } return(graph); } #read.nos - Read an input file in Neo-OrgStat format. At this time, only the #graph stack is read; any coloring information is ignored. read.nos<-function(file,return.as.edgelist=FALSE){ #Get the formatting information f<-sapply(readLines(file,n=2),strsplit," ") #Parse the formatting information m<-as.numeric((f[[1]])[1]) n<-as.numeric((f[[2]])[1]) o<-as.numeric((f[[2]])[2]) #Read the input data dat<-scan(file,skip=3) #Unpack the data in the proper order gstack<-array(dim=c(m,n,o)) for(i in 1:m) for(j in 1:n) for(k in 1:o) gstack[i,j,k]<-dat[(i-1)*n*o+(j-1)*o+k] #Return the stack if(return.as.edgelist) as.edgelist.sna(gstack) else gstack } #write.dl - Write a graph or graph stack in DL format write.dl<-function(x,file,vertex.lab=NULL,matrix.lab=NULL){ x<-as.sociomatrix.sna(x) if(is.list(x)) stop("DL format requires all graphs to be of identical order.") if(is.matrix(x)) x<-array(x,dim=c(1,NROW(x),NCOL(x))) m<-dim(x)[1] n<-dim(x)[2] #Write the DL header cat("DL n = ",n,", nm = ",m,", format = edgelist1\n",sep="",file=file) #Write the labels if(is.null(vertex.lab)) vertex.lab<-dimnames(x)[[2]] if(is.null(vertex.lab)) vertex.lab<-1:n if(is.character(vertex.lab)) vertex.lab<-paste("\"",vertex.lab,"\"",sep="") cat("labels:\n",file=file,append=TRUE) cat(paste(vertex.lab,collapse=","),"\n",sep="",file=file,append=TRUE) if(is.null(matrix.lab)) matrix.lab<-dimnames(x)[[1]] if(is.null(matrix.lab)) matrix.lab<-1:m if(is.character(matrix.lab)) matrix.lab<-paste("\"",matrix.lab,"\"",sep="") cat("matrix labels:\n",file=file,append=TRUE) cat(paste(matrix.lab,sep="",collapse=","),"\n",sep="",file=file, append=TRUE) #Write the data cat("data:\n",file=file,append=TRUE) for(i in 1:m){ edges<-x[i,,] #Obtain the matrix of edges edges[is.na(edges)]<-0 edges<-edges!=0 rn<-row(x[i,,])[edges] #Get rows, columns, values cn<-col(x[i,,])[edges] val<-x[i,,][edges] if(sum(edges>0)){ for(j in 1:length(rn)) #Write the edges cat(rn[j],cn[j],val[j],"\n",file=file,append=TRUE) } if(i # Last Modified 7/18/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains operators associated with the sna package. # # Contents: # %c% # gapply # gliop # logMean # logSub # logSum # ###################################################################### # GENERIC IS NOW PROVIDED BY network PACKAGE # generic for the c operator #"%c%"<-function(e1,e2){ # UseMethod("%c%",e1) #} #%c% - Composition of two adjacancy matrices "%c%.matrix"<-function(e1,e2){ #Pre-process the raw input x<-as.sociomatrix.sna(e1) y<-as.sociomatrix.sna(e2) if(!(is.matrix(x)&&is.matrix(y))) stop("Single graphs required for composition.") #End pre-processing round((x%*%y)>0) } #gapply - Apply a function to vertex neighborhoods within a graph gapply<-function(X,MARGIN,STATS,FUN,...,mode="digraph",diag=FALSE,distance=1,thresh=0,simplify=TRUE){ #Pre-process the raw input X<-as.sociomatrix.sna(X) if(is.list(X)) return(lapply(X,gapply,MARGIN,STATS,FUN,...,mode=mode, diag=diag,distance=distance,thresh=thresh,simplify=simplify)) else if(length(dim(X))>2){ return(apply(X,1,gapply,MARGIN,STATS,FUN,...,mode=mode, diag=diag,distance=distance,thresh=thresh,simplify=simplify)) } #End pre-processing #Match the input function fun<-match.fun(FUN) #Dichotomize, if needed X<-X>thresh #If needed, calculate the reachability graph if(distance>1) X<-geodist(X,inf.replace=Inf)$gdist<=distance #Remove unwanted elements if(!diag) diag(X)<-FALSE if(mode=="graph") X[lower.tri(X)]<-FALSE #Extract the relevant stats if(!is.matrix(STATS)) STATS<-matrix(STATS,ncol=1) if(length(MARGIN)==1){ if(MARGIN==1) stats<-apply(X,1,function(x){STATS[x,]}) else if(MARGIN==2) stats<-apply(X,2,function(x){STATS[x,]}) }else if(all(c(1,2)%in%MARGIN)) stats<-apply(symmetrize(X,rule="weak")>0,1,function(x){STATS[x,]}) else stop("MARGIN must be one of 1, 2, or c(1,2) in gapply. Exiting.\n") #Apply the function and return the result if(is.matrix(stats)) apply(stats,2,fun,...) else sapply(stats,fun,...,simplify=simplify) } #gliop - Return a binary operation on GLI values computed on two graphs (for #test routines). gliop<-function(dat,GFUN,OP="-",g1=1,g2=2,...){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if((!is.list(dat))&&(length(dim(dat))==2)) dat<-array(dat,dim=c(1,dim(dat))) #End pre-processing fun<-match.fun(GFUN) op<-match.fun(OP) if(is.list(dat)) op(fun(dat[[g1]],...),fun(dat[[g2]],...)) else op(fun(dat[g1,,],...),fun(dat[g2,,],...)) } #logMean - Find the mean of a vector of numbers in logspace. logMean<-function(x){ if(length(x)==0) numeric(0) else .C("logadd_R",as.double(x),as.integer(length(x)),lsum=as.double(0), NAOK=TRUE,PACKAGE="sna")$lsum-log(length(x)) } #logSub - Find the differences between two vectors of numbers in logspace. logSub<-function(x,y){ if(length(x)!=length(y)) stop("x and y must be of the same length.") else if(length(x)==0) numeric(0) else .C("logsub_R",as.double(x),as.double(y),as.integer(length(x)), ldiff=as.double(rep(0,length(x))),NAOK=TRUE,PACKAGE="sna")$ldiff } #logSum - Add a vector of numbers in logspace. logSum<-function(x){ if(length(x)==0) numeric(0) else .C("logadd_R",as.double(x),as.integer(length(x)),lsum=as.double(0), NAOK=TRUE,PACKAGE="sna")$lsum } sna/R/dataprep.R0000644000176200001440000007411414533477554013207 0ustar liggesusers###################################################################### # # dataprep.R # # copyright (c) 2004, Carter T. Butts # Last Modified 6/10/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains various routines for preparing/preprocessing data # for use with the sna package. # # Contents: # # add.isolates # as.edgelist.sna # as.sociomatrix.sna # diag.remove # ego.extract # event2dichot # gt # gvectorize # interval.graph # is.edgelist.sna # lower.tri.remove # make.stochastic # nties # sr2css # stackcount # symmetrize # upper.tri.remove # ###################################################################### #add.isolates - Add isolates to one or more graphs add.isolates<-function(dat,n,return.as.edgelist=FALSE){ dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,add.isolates,n=n,return.as.edgelist=return.as.edgelist)) #End pre-processing attr(dat,"n")<-attr(dat,"n")+n if(return.as.edgelist) dat else as.sociomatrix(dat) } #Force the input into edgelist form. Network size, directedness, and vertex #names are stored as attributes, since they cannot otherwise be included as.edgelist.sna<-function(x, attrname=NULL, as.digraph=TRUE, suppress.diag=FALSE, force.bipartite=FALSE,...){ #In case of lists, process independently # but this is tricky, since a 'network' object is also a list if((is.list(x)&&!inherits(x,"network") )&&(!inherits(x,c("network","matrix.csr","matrix.csc", "matrix.ssr","matrix.ssc", "matrix.hb","data.frame")))){ # call this function on each element of the list and return as a list return(lapply(x,as.edgelist.sna, attrname=attrname, as.digraph=as.digraph, suppress.diag=suppress.diag, force.bipartite=force.bipartite)) } #Begin with network objects if(inherits(x,"network")){ out<-as.matrix.network.edgelist(x,attrname=attrname,as.sna.edgelist=TRUE) #This should be fine unless we have an old version of network (<1.7); #here, we perform triage for old style objects. if(!("as.sna.edgelist"%in%names(formals(as.matrix.network.edgelist)))){ if(NCOL(out)==2) #If needed, add edge values out<-cbind(out,rep(1,NROW(out))) if(suppress.diag&&has.loops(x)) out<-out[!(out[,1]==out[,2]),] if((!is.directed(x))&&as.digraph){ if(has.loops(x)){ temp<-out[,1]==out[,2] if(any(temp)){ temp2<-out[temp,] out<-out[!temp,] out<-rbind(out,out[,c(2,1,3)]) out<-rbind(out,temp2) }else out<-rbind(out,out[,c(2,1,3)]) }else out<-rbind(out,out[,c(2,1,3)]) } attr(out,"n")<-network.size(x) attr(out,"vnames")<-network.vertex.names(x) } if(is.bipartite(x)) #Unneeded for new objects, but does no harm attr(out,"bipartite")<-get.network.attribute(x,"bipartite") else if(force.bipartite) out<-as.edgelist.sna(out,attrname=attrname,as.digraph=as.digraph, suppress.diag=suppress.diag,force.bipartite=force.bipartite) } else #Not a network -- is this a sparse matrix (from SparseM)? if(inherits(x,c("matrix.csr","matrix.csc","matrix.ssr","matrix.ssc", "matrix.hb"))){ requireNamespace("SparseM") #Need SparseM for this if(force.bipartite||(!is.null(attr(x,"bipartite")))|| (x@dimension[1]!=x@dimension[2])){ nr<-x@dimension[1] nc<-x@dimension[2] val<-x@ra if((!suppress.diag)&&inherits(x,c("matrix.ssr","matrix.ssc"))){ snd<-rep(1:nr,each=diff(x@ia)) rec<-nr+x@ja out<-cbind(snd,rec,val) out<-rbind(out,out[,c(2,1,3)]) }else{ snd<-switch(class(x)[1], matrix.csr=rep(1:nr,each=diff(x@ia)), matrix.csc=x@ja, matrix.ssr=c(rep(1:nr,each=diff(x@ia)),x@ja), matrix.ssc=c(x@ja,rep(1:nr,each=diff(x@ia))) ) rec<-switch(class(x)[1], matrix.csr=nr+x@ja, matrix.csc=rep(nr+(1:nc),each=diff(x@ia)), matrix.ssr=c(nr+x@ja,rep(1:n,each=diff(x@ia))), matrix.ssc=c(rep(nr+(1:nc),each=diff(x@ia)),x@ja) ) out<-cbind(snd,rec,val) out<-rbind(out,out[,c(2,1,3)]) } attr(out,"n")<-nr+nc attr(out,"vnames")<-NULL #No dimnames for these objects attr(out,"bipartite")<-nr }else{ n<-x@dimension[1] val<-x@ra if((!suppress.diag)&&inherits(x,c("matrix.ssr","matrix.ssc"))){ snd<-rep(1:n,times=diff(x@ia)) rec<-x@ja temp<-snd==rec out<-cbind(snd,rec,val) temp2<-out[temp,] out<-out[!temp,] out<-rbind(out,out[,c(2,1,3)]) out<-rbind(out,temp2) }else{ snd<-switch(class(x)[1], matrix.csr=rep(1:n,times=diff(x@ia)), matrix.csc=x@ja, matrix.ssr=c(rep(1:n,times=diff(x@ia)),x@ja), matrix.ssc=c(x@ja,rep(1:n,times=diff(x@ia))) ) rec<-switch(class(x)[1], matrix.csr=x@ja, matrix.csc=rep(1:n,times=diff(x@ia)), matrix.ssr=c(x@ja,rep(1:n,times=diff(x@ia))), matrix.ssc=c(rep(1:n,times=diff(x@ia)),x@ja) ) out<-cbind(snd,rec,val) if(suppress.diag) out<-out[!(out[,1]==out[,2]),] } attr(out,"n")<-n attr(out,"vnames")<-NULL #No dimnames for these objects } if(force.bipartite&&(is.null(attr(out,"bipartite")))) out<-as.edgelist.sna(out,attrname=attrname,as.digraph=as.digraph, suppress.diag=suppress.diag,force.bipartite=force.bipartite) } else #Matrix or data frame case if(is.matrix(x)||is.data.frame(x)){ if((NCOL(x)==3)&&(!is.null(attr(x,"n")))){ #Is this already an edgelist? out<-x if(force.bipartite&&(is.null(attr(out,"bipartite")))){ #Treat as bipartite out[,2]<-out[,2]+attr(x,"n") out<-rbind(out,out[,c(2,1,3)]) attr(out,"n")<-attr(x,"n")*2 attr(out,"bipartite")<-attr(x,"n") if(!is.null(attr(x,"vnames"))) attr(out,"vnames")<-c(attr(x,"vnames"),attr(x,"vnames")) else attr(out,"vnames")<-NULL } }else if((NCOL(x)==2)&&(!is.null(attr(x,"n")))){ #Is this an edgelist w/out vals? out<-cbind(x,rep(1,NROW(x))) attr(out,"n")<-attr(x,"n") attr(out,"bipartite")<-attr(x,"bipartite") attr(out,"vnames")<-attr(x,"vnames") if(force.bipartite&&(is.null(attr(out,"bipartite")))){ #Treat as bipartite out[,2]<-out[,2]+attr(x,"n") out<-rbind(out,out[,c(2,1,3)]) attr(out,"n")<-attr(x,"n")*2 attr(out,"bipartite")<-attr(x,"n") if(!is.null(attr(x,"vnames"))) attr(out,"vnames")<-c(attr(x,"vnames"),attr(x,"vnames")) else attr(out,"vnames")<-NULL } }else if(force.bipartite||(!is.null(attr(x,"bipartite")))|| (NROW(x)!=NCOL(x))){ #Assume this is a bipartite graph mask<-is.na(x)|(x!=0) if(sum(mask)>0){ snd<-row(x)[mask] rec<-NROW(x)+col(x)[mask] val<-x[mask] }else{ snd<-vector() rec<-vector() val<-vector() } out<-cbind(snd,rec,val) out<-rbind(out,out[,c(2,1,3)]) attr(out,"n")<-NROW(x)+NCOL(x) attr(out,"vnames")<-c(rownames(x),colnames(x)) attr(out,"bipartite")<-NROW(x) }else{ #Assume this is an adjmat mask<-is.na(x)|(x!=0) snd<-row(x)[mask] rec<-col(x)[mask] val<-x[mask] out<-cbind(snd,rec,val) attr(out,"n")<-NROW(x) attr(out,"vnames")<-rownames(x) } }else #Array case if(is.array(x)){ dx<-dim(x) ldx<-length(dx) if(ldx==2){ #Two-dimensional array if((dx[2]==3)&&(!is.null(attr(x,"n")))){ #Is this already an edgelist? out<-as.matrix(x) attr(out,"n")<-attr(x,"n") attr(out,"bipartite")<-attr(x,"bipartite") attr(out,"vnames")<-attr(x,"vnames") } if((NCOL(x)==2)&&(!is.null(attr(x,"n")))){ #Is this an edgelist w/out vals? out<-cbind(as.matrix(x),rep(1,NROW(x))) attr(out,"n")<-attr(x,"n") attr(out,"bipartite")<-attr(x,"bipartite") attr(out,"vnames")<-attr(x,"vnames") }else if(force.bipartite||(!is.null(attr(x,"bipartite")))|| (NROW(x)!=NCOL(x))){ #Assume this is a bipartite graph mask<-is.na(x)|(x!=0) if(sum(mask)>0){ snd<-row(x)[mask] rec<-NROW(x)+col(x)[mask] val<-x[mask] }else{ sna<-vector() rec<-vector() val<-vector() } out<-cbind(snd,rec,val) out<-rbind(out,out[,c(2,1,3)]) attr(out,"n")<-NROW(x)+NCOL(x) attr(out,"vnames")<-c(dimnames(x)[[1]],dimnames(x)[[2]]) attr(out,"bipartite")<-NROW(x) }else{ #Assume this is an adjmat mask<-is.na(x)|(x!=0) snd<-row(x)[mask] rec<-col(x)[mask] val<-x[mask] out<-cbind(snd,rec,val) attr(out,"n")<-NROW(x) attr(out,"vnames")<-dimnames(x)[[1]] } if(force.bipartite&&(is.null(attr(out,"bipartite")))){ #Treat as bipartite out[,2]<-out[,2]+attr(x,"n") out<-rbind(out,out[,c(2,1,3)]) attr(out,"n")<-attr(x,"n")*2 attr(out,"bipartite")<-attr(x,"n") if(!is.null(attr(x,"vnames"))) attr(out,"vnames")<-c(attr(x,"vnames"),attr(x,"vnames")) else attr(out,"vnames")<-NULL } }else if(ldx==3){ #Three-dimensional array out<-unlist(apply(x,1,function(z){list(as.edgelist.sna(z, attrname=attrname,as.digraph=as.digraph,suppress.diag=suppress.diag,force.bipartite=force.bipartite))}),recursive=FALSE) }else stop("Array input to as.edgelist.sna must either be a proper edgelist, an adjacency matrix, or an adjacency array.\n") }else{ stop("as.edgelist.sna input must be an adjacency matrix/array, edgelist matrix, network, or sparse matrix, or list thereof.\n") } #Return the result out } #Force the input into sociomatrix form. This function includes an sna #wrapper to the network function as.sociomatrix, for global happiness. as.sociomatrix.sna<-function(x, attrname=NULL, simplify=TRUE, force.bipartite=FALSE){ #If passed a list, operate on each element # but 'network' is also a list if((is.list(x)&&!inherits(x,"network"))&&(!inherits(x, c("network","matrix.csr","matrix.csc", "matrix.ssr","matrix.ssc", "matrix.hb","data.frame")))){ g<-lapply(x,as.sociomatrix.sna,attrname=attrname,simplify=simplify, force.bipartite=force.bipartite) #Otherwise, start with network }else if(inherits(x,"network")){ g<-as.sociomatrix(x, attrname=attrname, simplify=simplify) #Not a network -- is this a sparse matrix (from SparseM)? }else if(inherits(x, c("matrix.csr","matrix.csc","matrix.ssr","matrix.ssc", "matrix.hb"))){ requireNamespace("SparseM") #Need SparseM for this bip<-attr(x,"bipartite") g<-as.matrix(x) #Coerce to matrix form, and pass on attr(g,"bipartite")<-bip }else{ #Coerce to adjacency matrix form -- by now, no other classes involved n<-attr(x,"n") #Grab attributes before they get lost bip<-attr(x,"bipartite") vnam<-attr(x,"vnames") if(is.array(x)&&(length(dim(x))==2)) #Quick diversion for 2-d arrays x<-as.matrix(x) if(is.data.frame(x)) #Coerce data frames to matrices x<-as.matrix(x) if(is.matrix(x)){ if((NCOL(x)%in%c(2,3))&&(!is.null(n))){ #sna edgelist if(NCOL(x)==2) x<-cbind(x,rep(1,NROW(x))) g<-matrix(0,n,n) if(NROW(x)>0) g[x[,1:2,drop=FALSE]]<-x[,3] rownames(g)<-vnam colnames(g)<-vnam }else if(force.bipartite||(!is.null(bip))||(NROW(x)!=NCOL(x))){ #Bipartite adjmat nr<-NROW(x) nc<-NCOL(x) g<-matrix(0,nr+nc,nr+nc) g[1:nr,(nr+1):(nr+nc)]<-x g[(nr+1):(nr+nc),1:nr]<-t(x) rownames(g)<-vnam colnames(g)<-vnam }else{ #Regular adjmat g<-x } }else if(is.array(x)){ #If an array, test for type if(length(dim(x))!=3) stop("as.sociomatrix.sna input must be an adjacency matrix/array, network, data frame, sparse matrix, or list.") if(force.bipartite||(!is.null(attr(x,"bipartite")))|| (dim(x)[2]!=dim(x)[3])){ #Bipartite stack dx<-dim(x) nr<-dx[2] nc<-dx[3] g<-array(0,dim=c(dx[1],nr+nc,nr+nc)) for(i in 1:dx[1]){ g[i,1:nr,(nr+1):(nr+nc)]<-x[i,,] g[i,(nr+1):(nr+nc),1:nr]<-t(x[i,,]) } }else{ #Adjacency stack g<-x } }else{ stop("as.sociomatrix.sna input must be an adjacency matrix/array, network, or list.") } } #Convert into the appropriate return format if(is.list(g)){ #Collapse if needed if(length(g)==1){ g<-g[[1]] if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else{ out<-g } }else{ #Coerce to array form? if(simplify){ dims<-sapply(g,dim) if(is.list(dims)){ #Dims must not be of equal length mats<-sapply(dims,length) mats[mats==1]<-0 mats[mats==2]<-1 mats[mats==3]<-sapply(dims[mats==3],"[[",1) mats<-cumsum(mats) dims<-sapply(dims,"[",2) }else{ #Dims are of equal length if(NROW(dims)==3) #Determine number of matrices per entry mats<-cumsum(dims[1,]) else mats<-1:NCOL(dims) dims<-dims[2,] #Get ncols } if((!any(is.null(dims)))&&(length(unique(dims))==1)&&(all(mats>0))){ out<-array(dim=c(mats[length(mats)],dims[1],dims[1])) for(i in 1:length(mats)) out[(c(0,mats)[i]+1):(mats[i]),,]<-g[[i]] }else out<-g }else out<-g } }else{ if((!simplify)&&(length(dim(g))==3)){ #Coerce to a list of matrices? out<-list() for(i in 1:dim(g)[1]) out[[i]]<-g[i,,] }else out<-g } #Return the result out } #diag.remove - NA the diagonals of adjacency matrices in a graph stack diag.remove<-function(dat,remove.val=NA){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,diag.remove,remove.val=remove.val)) #End pre-processing if(length(dim(dat))>2){ d<-dat for(i in 1:dim(dat)[1]) diag(d[i,,])<-remove.val } else{ d<-dat diag(d)<-remove.val } d } #ego.extract - Extract ego nets from an input graph, returning them as a #list of graphs. ego.extract<-function(dat,ego=NULL,neighborhood=c("combined","in","out")){ #Pre-process the raw input d<-as.sociomatrix.sna(dat) if(is.list(d)) return(lapply(d,ego.extract,ego=ego,neighborhood=neighborhood)) else if(length(dim(dat))==3) return(apply(d,1,ego.extract,ego=ego,neighborhood=neighborhood)) #End pre-processing #Set input arguments if(is.null(ego)) ego<-1:NROW(d) neighborhood<-match.arg(neighborhood) #Extract the selected ego nets enet<-list() for(i in 1:length(ego)){ #Walk the ego list sel<-switch(neighborhood, #Grab the alters "in"=(1:NROW(d))[d[,ego[i]]>0], "out"=(1:NROW(d))[d[ego[i],]>0], "combined"=(1:NROW(d))[(d[ego[i],]>0)|(d[,ego[i]]>0)] ) if(length(sel)>0) sel<-c(ego[i],sel[sel!=ego[i]]) #Force ego to be first else sel<-ego[i] enet[[i]]<-d[sel,sel,drop=FALSE] #Perform the extraction } #Return the result if(!is.null(rownames(d))) #Try to name the egos.... names(enet)<-rownames(d)[ego] else if(!is.null(colnames(d))) names(enet)<-colnames(d)[ego] else names(enet)<-ego enet } #event2dichot - Convert an observed event matrix to a dichotomous matrix. #Methods are quantile, mean, rquantile, rmean, cquantile, cmean, absolute, rank, #rrank, and crank. Thresh specifies the cutoff, in terms of whatever method is #used (if applicable). event2dichot<-function(m,method="quantile",thresh=0.5,leq=FALSE){ #Pre-process the raw input m<-as.sociomatrix.sna(m) if(is.list(m)) return(lapply(m,event2dichot,method=method,thresh=thresh,leq=leq)) #End pre-processing rnam<-rownames(m) cnam<-colnames(m) if(method=="quantile"){ q<-quantile(m,thresh,na.rm=TRUE, names=FALSE) out<-as.numeric(m>q) } else if(method=="rquantile"){ q<-quantile(m[1,],thresh,na.rm=TRUE, names=FALSE) out<-as.numeric(m[1,]>q) for(i in 2:dim(m)[1]){ q<-quantile(m[i,],thresh,na.rm=TRUE, names=FALSE) out<-rbind(out,as.numeric(m[i,]>q)) } } else if(method=="cquantile"){ q<-quantile(m[,1],thresh,na.rm=TRUE, names=FALSE) out<-as.numeric(m[,1]>q) for(i in 2:dim(m)[2]){ q<-quantile(m[,i],thresh,na.rm=TRUE, names=FALSE) out<-cbind(out,as.numeric(m[,i]>q)) } } else if(method=="mean"){ q<-mean(m) out<-as.numeric(m>q) } else if(method=="rmean"){ q<-mean(m[1,]) out<-as.numeric(m[1,]>q) for(i in 2:dim(m)[1]){ q<-mean(m[i,]) out<-rbind(out,as.numeric(m[i,]>q)) } } else if(method=="cmean"){ q<-mean(m[,1]) out<-as.numeric(m[,1]>q) for(i in 2:dim(m)[2]){ q<-mean(m[,i]) out<-rbind(out,as.numeric(m[,i]>q)) } } else if(method=="absolute"){ out<-as.numeric(m>thresh) } else if(method=="rank"){ o<-order(m) out<-as.numeric((max(o)-o+1)2){ m<-dim(mats)[1] n<-dim(mats)[2] n<-dim(mats)[3] d<-mats }else{ m<-1 n<-dim(mats)[1] o<-dim(mats)[2] d<-array(dim=c(1,n,o)) d[1,,]<-mats } #If using NA censoring, turn unused parts of the matrices to NAs and vectorize if(censor.as.na){ if(mode=="graph") d<-upper.tri.remove(d) if(!diag) d<-diag.remove(d) out<-apply(d,1,as.vector) }else{ #Otherwise, vectorize only the useful parts if(mode=="graph") mask<-apply(d,1,lower.tri,diag=diag) else{ if(diag) mask<-matrix(TRUE,nrow=dim(d)[2]*dim(d)[3],ncol=dim(d)[1]) else mask<-apply(d,1,function(z){diag(NROW(z))==0}) } out<-apply(d,1,as.vector) if(m==1) out<-out[mask] else out<-matrix(out[mask],ncol=m) } out } #interval.graph - Construct one or more interval graphs (and exchangeability #vectors) from a set of spells interval.graph<-function(slist,type="simple",diag=FALSE){ #Note that each slice of slist must have one spell per row, with col 1 containing the spell type, #col 2 containing the spell onset, and col 3 containing the spell termination. If there are multiple #slices present, they must be indexed by the first dimension of the array. #First, the preliminaries o<-list() m<-stackcount(slist) #Get the number of stacks if(m==1){ d<-array(dim=c(m,dim(slist)[1],dim(slist)[2])) d[1,,]<-slist }else d<-slist ns<-dim(d)[2] #Get the number of spells o$exchange.list<-d[,,1] #Exchange list is just the vector of spell types #Now, for the graph itself... o$graph<-array(dim=c(m,ns,ns)) for(i in 1:ns) for(j in 1:ns) o$graph[,i,j]<-switch(type, simple=as.numeric((d[,i,2]<=d[,j,3])&(d[,i,3]>=d[,j,2])), #"Start before the end, end after the beginning" overlap=pmax(pmin(d[,i,3],d[,j,3])-pmax(d[,i,2],d[,j,2]),0), fracxy=pmax(pmin(d[,i,3],d[,j,3])-pmax(d[,i,2],d[,j,2]),0)/(d[,i,3]-d[,i,2]), fracyx=pmax(pmin(d[,i,3],d[,j,3])-pmax(d[,i,2],d[,j,2]),0)/(d[,j,3]-d[,j,2]), jntfrac=2*pmax(pmin(d[,i,3],d[,j,3])-pmax(d[,i,2],d[,j,2]),0)/(d[,i,3]-d[,i,2]+d[,j,3]-d[,j,2]) ) #Patch up those loose ends. if(m==1) o$graph<-o$graph[1,,] if(!diag) o$graph<-diag.remove(o$graph,remove.val=0) #Return the data structure o } #is.edgelist.sna - check to see if a data object is an sna edgelist is.edgelist.sna<-function(x){ if(is.list(x)&&(!inherits(x,"network"))) return(sapply(x,is.edgelist.sna)) if(!inherits(x,c("matrix","array"))) FALSE else if(length(dim(x))!=2) FALSE else if(dim(x)[2]!=3) FALSE else if(is.null(attr(x,"n"))) FALSE else TRUE } #lower.tri.remove - NA the lower triangles of adjacency matrices in a graph #stack lower.tri.remove<-function(dat,remove.val=NA){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,lower.tri.remove,val=remove.val)) #End pre-processing if(length(dim(dat))>2){ d<-dat for(i in 1:dim(dat)[1]){ temp<-d[i,,] temp[lower.tri(temp,diag=FALSE)]<-remove.val d[i,,]<-temp } } else{ d<-dat d[lower.tri(d,diag=FALSE)]<-remove.val } d } #make.stochastic - Make a graph stack row, column, or row-column stochastic make.stochastic<-function(dat,mode="rowcol",tol=0.005,maxiter=prod(dim(dat))*100,anneal.decay=0.01,errpow=1){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,make.stochastic,mode=mode,tol=tol,maxiter=maxiter, anneal.decay=anneal.decay,errpow=errpow)) #End pre-processing #Organize the data m<-stackcount(dat) if(m==1){ n<-dim(dat)[1] o<-dim(dat)[2] d<-array(dim=c(m,n,o)) d[1,,]<-dat }else{ n<-dim(dat)[2] o<-dim(dat)[3] d<-dat } #Stochasticize if(mode=="row"){ for(i in 1:m) d[i,,]<-d[i,,]/t(sapply(apply(d[i,,],1,sum),rep,o)) }else if(mode=="col"){ for(i in 1:m) d[i,,]<-d[i,,]/sapply(apply(d[i,,],2,sum),rep,n) }else if(mode=="rowcol"){ for(i in 1:m){ f<-d[i,,]/t(sapply(apply(d[i,,],1,sum),rep,o)) #Seed with the row-stochastic form f<-f/sapply(apply(f,2,sum),rep,n) #Col-stochasticize for good measure (sometimes this works) edgelist<-cbind(rep(1:n,o),rep(1:o,rep(n,o))) edgelist<-edgelist[d[i,,][edgelist]>0,] #Skip edges which are forced to be zero-valued err<-sum(abs(apply(f,2,sum)-rep(1,o))^errpow,abs(apply(f,1,sum)-rep(1,n))^errpow) iter<-0 while((err>(n+o)*tol)&(iter(n+o)*tol) warning(paste("Annealer unable to reduce total error below apx",round(err,digits=7),"in matrix",i,". Hope that's OK....\n")) } }else if(mode=="total"){ for(i in 1:m) d[i,,]<-d[i,,]/sum(d[i,,]) } #Patch NaN values d[is.nan(d)]<-0 #Return the output if(m==1) d[1,,] else d } #nties - Find the number of ties in a given graph or stack nties<- function(dat,mode="digraph",diag=FALSE){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,nties,mode=mode,diag=diag)) #End pre-processing #Did someone send us a stack? if(length(dim(dat))>2) shiftit<-1 else shiftit<-0 #Get size params n<-dim(dat)[1+shiftit] m<-dim(dat)[2+shiftit] #Sanity check for hypergraphs if(mode=="hgraph") diag<-TRUE #Get the initial count count<-switch(mode, digraph = n*n, graph = (n*n-n)/2+n, hgraph = n*m ) #Modify for diag, if needed if(!diag) count<-count-n #Return the needed info if(shiftit) rep(count,dim(dat)[1]) else count } #sr2css - Convert a row-wise self-report matrix to a CSS matrix with missing #observations. sr2css<-function(net){ #Pre-process the raw input dat<-as.sociomatrix.sna(net) if(is.list(net)) return(lapply(net)) #End pre-processing n<-dim(net)[1] css<-array(dim=c(n,n,n)) for(i in 1:n){ css[i,,]<-NA css[i,i,]<-net[i,] } css } #stackcount -How many matrices in a given stack? stackcount<-function(d){ #Pre-process the raw input d<-as.edgelist.sna(d) #End pre-processing if(is.list(d)) length(d) else 1 } #symmetrize - Convert a graph or graph stack to a symmetric form. Current rules #for symmetrizing include "upper" and "lower" diagonals, "weak" connectedness #rule, and a "strong" connectedness rule. If return.as.edgelist=TRUE, the #data is processed and returned in sna edgelist form. symmetrize<-function(mats,rule="weak",return.as.edgelist=FALSE){ if(!return.as.edgelist){ #Adjacency matrix form #Pre-process the raw input mats<-as.sociomatrix.sna(mats) if(is.list(mats)) return(lapply(mats,symmetrize,rule=rule, return.as.edgelist=return.as.edgelist)) #End pre-processing #Build the input data structures if(length(dim(mats))>2){ m<-dim(mats)[1] n<-dim(mats)[2] o<-dim(mats)[3] d<-mats }else{ m<-1 n<-dim(mats)[1] o<-dim(mats)[2] d<-array(dim=c(1,n,o)) d[1,,]<-mats } #Apply the symmetry rule for(i in 1:m){ if(rule=="upper"){ d[i,,][lower.tri(d[i,,])]<-t(d[i,,])[lower.tri(d[i,,])] }else if(rule=="lower"){ d[i,,][upper.tri(d[i,,])]<-t(d[i,,])[upper.tri(d[i,,])] }else if(rule=="weak"){ d[i,,]<-matrix(as.numeric(d[i,,]|t(d[i,,])),nrow=n,ncol=o) }else if(rule=="strong"){ d[i,,]<-matrix(as.numeric(d[i,,]&t(d[i,,])),nrow=n,ncol=o) } } #Return the symmetrized matrix if(m==1) out<-d[1,,] else out<-d out }else{ #Edgelist matrix form #Pre-process the raw input mats<-as.edgelist.sna(mats) if(is.list(mats)) return(lapply(mats,symmetrize,rule=rule, return.as.edgelist=return.as.edgelist)) #End pre-processing n<-attr(mats,"n") vn<-attr(mats,"vnames") bip<-attr(mats,"bipartite") if(!is.null(bip)) return(mats) #Return unaltered if bipartite #Apply the symmetry rule if(rule=="upper"){ loops<-mats[mats[,1]==mats[,2],,drop=FALSE] upedge<-mats[mats[,1]mats[,2],,drop=FALSE] mats<-rbind(loedge,loedge[,c(2,1,3)],loops) }else if(rule=="weak"){ isloop<-mats[,1]==mats[,2] loops<-mats[isloop,,drop=FALSE] mats<-mats[!isloop,,drop=FALSE] dc<-.C("dyadcode_R",as.double(mats),as.integer(n),as.integer(NROW(mats)), dc=as.double(rep(0,NROW(mats))),PACKAGE="sna",NAOK=TRUE)$dc isdup<-duplicated(dc) mats<-mats[!isdup,,drop=FALSE] mats<-rbind(mats,mats[,c(2,1,3)],loops) }else if(rule=="strong"){ isloop<-mats[,1]==mats[,2] loops<-mats[isloop,,drop=FALSE] mats<-mats[!isloop,,drop=FALSE] dc<-.C("dyadcode_R",as.double(mats),as.integer(n),as.integer(NROW(mats)), dc=as.double(rep(0,NROW(mats))),PACKAGE="sna",NAOK=TRUE)$dc isdup<-duplicated(dc) mats<-mats[isdup,,drop=FALSE] mats<-rbind(mats,mats[,c(2,1,3)],loops) } #Patch up the attributes and return attr(mats,"n")<-n attr(mats,"vnames")<-vn mats } } #upper.tri.remove - NA the upper triangles of adjacency matrices in a graph #stack upper.tri.remove<-function(dat,remove.val=NA){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,upper.tri.remove,remove.val=remove.val)) #End pre-processing if(length(dim(dat))>2){ d<-dat for(i in 1:dim(dat)[1]){ temp<-d[i,,] temp[upper.tri(temp,diag=FALSE)]<-remove.val d[i,,]<-temp } } else{ d<-dat d[upper.tri(d,diag=FALSE)]<-remove.val } d } sna/R/permutation.R0000644000176200001440000005355214533477501013751 0ustar liggesusers###################################################################### # # permutation.R # # copyright (c) 2004, Carter T. Butts # Last Modified 4/23/05 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to permutations on graphs. # # Contents: # lab.optimize # lab.optimize.anneal # lab.optimize.exhaustive # lab.optimize.gumbel # lab.optimize.hillclimb # lab.optimize.mc # numperm # rmperm # rperm # ###################################################################### #lab.optimize - Optimize a function over the accessible permutation groups of two or more graphs. This routine is a front end for various method-specific functions, and is in turn intended to be called from structural distance/covariance routines and the like. The methods supported at this time include "exhaustive" (exhaustive search - I hope these are _small_ graphs!), "mc" (simple monte carlo search), " lab.optimize<-function(d1,d2,FUN,exchange.list=0,seek="min",opt.method=c("anneal","exhaustive","mc","hillclimb","gumbel"),...){ meth<-match.arg(opt.method) if(meth=="anneal") lab.optimize.anneal(d1,d2,FUN,exchange.list,seek,...) else if(meth=="exhaustive") lab.optimize.exhaustive(d1,d2,FUN,exchange.list,seek,...) else if(meth=="mc") lab.optimize.mc(d1,d2,FUN,exchange.list,seek,...) else if(meth=="hillclimb") lab.optimize.hillclimb(d1,d2,FUN,exchange.list,seek,...) else if(meth=="gumbel"){ warning("Warning, gumbel method not yet supported. Try at your own risk.\n") lab.optimize.gumbel(d1,d2,FUN,exchange.list,seek,...) } } #lab.optimize.anneal - Annealing method for lab.optimize lab.optimize.anneal<-function(d1,d2,FUN,exchange.list=0,seek="min",prob.init=1,prob.decay=0.99,freeze.time=1000,full.neighborhood=TRUE,...){ #Pre-process the raw input data d1<-as.sociomatrix.sna(d1) d2<-as.sociomatrix.sna(d2) if(is.list(d1)||is.list(d2)||(dim(d1)[2]!=dim(d2)[2])) stop("lab.optimize routines require input graphs to be of identical order.") #End pre-processing #Find the data set size n<-dim(d1)[2] #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,2*n),nrow=2,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,2) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Initialize various things fun<-match.fun(FUN) #Find the function to be optimized d1<-d1[order(el[1,]),order(el[1,])] #Reorder d1 d2<-d2[order(el[2,]),order(el[2,])] #Reorder d2 el[1,]<-el[1,order(el[1,])] #Reorder the exchange lists to match el[2,]<-el[2,order(el[2,])] if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") best<-fun(d1,d2,...) #Take the seed value (this has to be legal) o<-1:n #Set the initial ordering global.best<-best #Set global best values global.o<-o prob<-prob.init #Set acceptance prob ftime<-freeze.time #Set time until freezing occurs nc<-choose(n,2) #How many candidate steps? candp<-sapply(o,rep,choose(n,2)) #Build the candidate permutation matrix ccount<-1 for(i in 1:n) for(j in i:n) if(i!=j){ #Perform binary exchanges temp<-candp[ccount,i] candp[ccount,i]<-candp[ccount,j] candp[ccount,j]<-temp ccount<-ccount+1 } #Run the annealer flag<-FALSE if(any(duplicated(el[2,]))) #If we're dealing with the labeled case, don't bother. while((!flag)|(ftime>0)){ #Until we both freeze _and_ reach an optimum... #cat("Best: ",o," Perf: ",best," Global best: ",global.o," Global perf: ",global.best," Temp: ",prob,"\n") #cat("Perf: ",best," Global perf: ",global.best," Temp: ",prob,"\n") flag<-TRUE if(full.neighborhood){ #Full neighborhood search method - much slower, but more likely to find the optimum candperf<-vector() for(i in 1:nc) #Use candidate permutation matrix to produce new candidates if(all(el[2,]==el[2,o[candp[i,]]])) #Is this legal? candperf[i]<-fun(d1,d2[o[candp[i,]],o[candp[i,]]],...) else candperf[i]<-NA #If not, put the results in as missing data if(seek=="min"){ bestcand<-(1:nc)[candperf==min(candperf,na.rm=TRUE)] #Find the best candidate bestcand<-bestcand[!is.na(bestcand)] if(length(bestcand)>1) bestcand<-sample(bestcand,1) #If we have multiple best candidates, choose one at random #cat(min(candperf,na.rm=TRUE),bestcand,candperf[bestcand],"\n") if(candperf[bestcand]0)&(runif(1,0,1)1) bestcand<-sample(bestcand,1) #If we have multiple best candidates, choose one at random if((candperf[bestcand]>best)|(runif(1,0,1)global.best){ #Check to see if this is better than the global best global.best<-best global.o<-o } }else if((ftime>0)&(runif(1,0,1)0)&(runif(1,0,1)best){ #If this is better, move on and keep looking... o<-o[candp[i,]] best<-candperf flag<-FALSE if(best>global.best){ #Check to see if this is better than the global best global.best<-best global.o<-o } }else if((ftime>0)&(runif(1,0,1)global.best){ #Check to see if this is better than the global best global.best<-best global.o<-o } } } } #Set things up for the next iteration (if there is one) ftime<-ftime-1 #Continue the countdown to the freezing point prob<-prob*prob.decay #Cool things off a bit } #Report the results global.best } #lab.optimize.exhaustive - Exhaustive search method for lab.optimize lab.optimize.exhaustive<-function(d1,d2,FUN,exchange.list=0,seek="min",...){ #Pre-process the raw input data d1<-as.sociomatrix.sna(d1) d2<-as.sociomatrix.sna(d2) if(is.list(d1)||is.list(d2)||(dim(d1)[2]!=dim(d2)[2])) stop("lab.optimize routines require input graphs to be of identical order.") #End pre-processing #Find the data set size n<-dim(d1)[2] #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,2*n),nrow=2,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,2) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Initialize various things fun<-match.fun(FUN) #Find the function to be optimized d1<-d1[order(el[1,]),order(el[1,])] #Reorder d1 d2<-d2[order(el[2,]),order(el[2,])] #Reorder d2 el[1,]<-el[1,order(el[1,])] #Reorder the exchange lists to match el[2,]<-el[2,order(el[2,])] if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") best<-fun(d1,d2,...) #Take the seed value (this has to be legal) #Search exhaustively - I hope you're not in a hurry! if(any(duplicated(el[1,]))) #If we're dealing with the labeled case, don't bother. for(k in 0:(gamma(n+1)-1)){ o<-numperm(n,k) if(all(el[1,]==el[2,o])){ if(seek=="min") best<-min(best,fun(d1,d2[o,o],...)) else best<-max(best,fun(d1,d2[o,o],...)) } } #Report the results best } #lab.optimize.gumbel - Extreme value method for lab.optimize lab.optimize.gumbel<-function(d1,d2,FUN,exchange.list=0,seek="min",draws=500,tol=1e-5,estimator="median",...){ #Pre-process the raw input data d1<-as.sociomatrix.sna(d1) d2<-as.sociomatrix.sna(d2) if(is.list(d1)||is.list(d2)||(dim(d1)[2]!=dim(d2)[2])) stop("lab.optimize routines require input graphs to be of identical order.") #End pre-processing #Find the data set size n<-dim(d1)[2] #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,2*n),nrow=2,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,2) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Initialize various things fun<-match.fun(FUN) #Find the function to be optimized fg<-vector() #Set up the function d1<-d1[order(el[1,]),order(el[1,])] #Reorder d1 d2<-d2[order(el[2,]),order(el[2,])] #Reorder d2 el[1,]<-el[1,order(el[1,])] #Reorder the exchange lists to match el[2,]<-el[2,order(el[2,])] if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") #Approximate the distribution using Monte Carlo for(i in 1:draws){ o<-rperm(el[2,]) fg[i]<-fun(d1,d2[o,o],...) } #Use the approximated distribution to fit a Gumbel model for the extreme values; #this is only approximate, since the extreme value model assumes an unbounded, continuous underlying #distribution. Also, these results are "unproven," in the sense that no actual permutation has been #found by the algorithm which results in the predicted value (unlike the other methods); OTOH, in #a world of approximations, this one may not be any worse than the others.... b<-1 b.old<-1 bdiff<-Inf mfg<-mean(fg) print(quantile(fg)) while(bdiff>tol){ #Solve iteratively for bhat cat("bold=",b.old,"b=",b,"bdiff=",bdiff,"\n") b.old<-b b<-mfg-sum(fg*exp(-fg/b))/sum(exp(-fg/b)) bdiff<-abs(b.old-b) } a<--b*log(sum(exp(-fg/b))/draws) #Given this, ahat is a function of bhat and the data #Report the results cat("a=",a,"b=",b,"\n") switch(estimator, mean=a-b*digamma(1), mode=a, median=a-b*log(log(2)) ) } #lab.optimize.hillclimb - Hill-climbing method for lab.optimize lab.optimize.hillclimb<-function(d1,d2,FUN,exchange.list=0,seek="min",...){ #Pre-process the raw input data d1<-as.sociomatrix.sna(d1) d2<-as.sociomatrix.sna(d2) if(is.list(d1)||is.list(d2)||(dim(d1)[2]!=dim(d2)[2])) stop("lab.optimize routines require input graphs to be of identical order.") #End pre-processing #Find the data set size n<-dim(d1)[2] #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,2*n),nrow=2,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,2) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Initialize various things fun<-match.fun(FUN) #Find the function to be optimized d1<-d1[order(el[1,]),order(el[1,])] #Reorder d1 d2<-d2[order(el[2,]),order(el[2,])] #Reorder d2 el[1,]<-el[1,order(el[1,])] #Reorder the exchange lists to match el[2,]<-el[2,order(el[2,])] if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") best<-fun(d1,d2,...) #Take the seed value (this has to be legal) o<-1:n #Set the initial ordering nc<-choose(n,2) #How many candidate steps? candp<-sapply(o,rep,choose(n,2)) #Build the candidate permutation matrix ccount<-1 for(i in 1:n) for(j in i:n) if(i!=j){ #Perform binary exchanges temp<-candp[ccount,i] candp[ccount,i]<-candp[ccount,j] candp[ccount,j]<-temp ccount<-ccount+1 } #Run the hill climber flag<-FALSE while(!flag){ #Until we reach an optimum... #cat("Best: ",o," Perf: ",best,"\n") flag<-TRUE candperf<-vector() for(i in 1:nc) #Use candidate permutation matrix to produce new candidates if(all(el[2,]==el[2,o[candp[i,]]])) #Is this legal? candperf[i]<-fun(d1,d2[o[candp[i,]],o[candp[i,]]],...) else candperf[i]<-NA #If not, put the results in as missing data if(seek=="min"){ bestcand<-(1:nc)[candperf==min(candperf,na.rm=TRUE)] #Find the best candidate if(length(bestcand)>1) bestcand<-sample(bestcand,1) #If we have multiple best candidates, choose one at random if(candperf[bestcand]1) bestcand<-sample(bestcand,1) #If we have multiple best candidates, choose one at random if(candperf[bestcand]>best){ #If this is better, move on and keep looking... o<-o[candp[bestcand,]] best<-candperf[bestcand] flag<-FALSE } } } #Report the results best } #lab.optimize.mc - Monte Carlo method for lab.optimize lab.optimize.mc<-function(d1,d2,FUN,exchange.list=0,seek="min",draws=1000,...){ #Pre-process the raw input data d1<-as.sociomatrix.sna(d1) d2<-as.sociomatrix.sna(d2) if(is.list(d1)||is.list(d2)||(dim(d1)[2]!=dim(d2)[2])) stop("lab.optimize routines require input graphs to be of identical order.") #End pre-processing #Find the data set size n<-dim(d1)[2] #If exchange list is a single number or vector, expand it via replication in a reasonable manner if(is.null(dim(exchange.list))){ #Exchange list was given as a single number or vector if(length(exchange.list)==1){ #Single number case el<-matrix(rep(exchange.list,2*n),nrow=2,ncol=n) }else{ #Vector case el<-sapply(exchange.list,rep,2) } }else #Exchange list was given as a matrix; keep it. el<-exchange.list #Initialize various things fun<-match.fun(FUN) #Find the function to be optimized d1<-d1[order(el[1,]),order(el[1,])] #Reorder d1 d2<-d2[order(el[2,]),order(el[2,])] #Reorder d2 el[1,]<-el[1,order(el[1,])] #Reorder the exchange lists to match el[2,]<-el[2,order(el[2,])] if(any(el[1,]!=el[2,])) #Make sure the exlist is legal stop("Illegal exchange list; lists must be comparable!\n") best<-fun(d1,d2,...) #Take the seed value (this has to be legal) #Search via blind monte carlo - slow, yet ineffectual if(any(duplicated(el[1,]))) #If we're dealing with the labeled case, don't bother. for(i in 1:draws){ o<-rperm(el[2,]) if(seek=="min") best<-min(best,fun(d1,d2[o,o],...)) else best<-max(best,fun(d1,d2[o,o],...)) } #Report the results best } #numperm - Get the nth permutation vector by periodic placement numperm<-function(olength,permnum){ if((permnum>gamma(olength+1)-1)|(permnum<0)){ cat("permnum must be an integer in [0,olength!-1]\n") } o<-vector(length=olength) o[]<--1 pnum<-permnum for(i in 1:olength){ relpos<-pnum%%(olength-i+1) flag<-FALSE p<-1 while(!flag) if(o[p]==-1){ if(relpos==0){ o[p]<-i flag<-TRUE }else{ p<-p+1 relpos<-relpos-1 } }else p<-p+1 pnum<-pnum%/%(olength-i+1) } o } #rmperm - Randomly permutes the rows and columns of an input matrix. rmperm<-function(m){ #Pre-process the raw input m<-as.sociomatrix.sna(m) if(is.list(m)) return(lapply(m,rmperm)) #End pre-processing if(length(dim(m))==2){ #Only a single matrix is included o<-sample(1:dim(m)[1]) p<-matrix(data=m[o,o],nrow=dim(m)[1],ncol=dim(m)[2]) }else{ #Here, we assume a stack of matrices p<-array(dim=c(dim(m)[1],dim(m)[2],dim(m)[3])) for(i in 1:dim(m)[1]){ o<-sample(1:dim(m)[2]) p[i,,]<-array(m[i,o,o]) } } p } #rperm - Draw a random permutation vector with exchangability constraints rperm<-function(exchange.list){ #Note that exchange.list should be a vector whose entries correspond to the class identity #of the respective element. It doesn't matter what the values are, so long as elements have #the same value iff they are exchangeable. n<-length(exchange.list) #Get the length of the output vector grp<-unique(exchange.list) #Get the groups o<-1:n #Create the initial ordering #Randomly scramble orders within groups for(i in grp){ v<-(1:n)[exchange.list==i] if(length(v)>1) #Need this test, because sample is too smart for its own good... o[v]<-sample(v) } #Return the permutation o } sna/R/gtest.R0000644000176200001440000002361514533477524012532 0ustar liggesusers###################################################################### # # gtest.R # # copyright (c) 2004, Carter T. Butts # Last Modified 10/5/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to null hypothesis testing. # # Contents: # cug.test # cugtest # plot.cug.test # plot.cugtest # plot.qaptest # print.cug.test # print.cugtest # print.qaptest # print.summary.cugtest # print.summary.qaptest # qaptest # summary.cugtest # summary.qaptest # ###################################################################### #Second generation (univariate) CUG test routine cug.test<-function(dat,FUN,mode=c("digraph","graph"),cmode=c("size","edges","dyad.census"),diag=FALSE,reps=1000,ignore.eval=TRUE,FUN.args=list()){ if(ignore.eval){ #Handle everything in edgelist form here #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat,cug.test,FUN=FUN,mode=mode,cmode=cmode,diag=diag, reps=reps,ignore.eval=ignore.eval,FUN.args=FUN.args)) #End pre-processing n<-attr(dat,"n") if(!diag){ dat<-dat[dat[,1]!=dat[,2],,drop=FALSE] attr(dat,"n")<-n ndiag<-0 }else ndiag<-sum(dat[,1]==dat[,2]) mode<-match.arg(mode) cmode<-match.arg(cmode) #Generate conditioning statistics if(cmode=="size"){ m<-NULL dc<-NULL }else if(cmode=="edges"){ m<-switch(match.arg(mode), graph=(NROW(dat)-ndiag)/2+ndiag, digraph=NROW(dat) ) dc<-NULL }else if(cmode=="dyad.census"){ m<-NULL dc<-dyad.census(dat) } #Generate randomization functions getstat<-function(d){do.call(fun,c(list(d),FUN.args))} drawrep<-switch(cmode, size=function(n,...){rgraph(n,1,mode=mode,diag=diag,tprob=0.5, return.as.edgelist=TRUE)}, edges=function(n,m,...){rgnm(n=1,nv=n,m=m,mode=mode,diag=diag, return.as.edgelist=TRUE)}, dyad.census=function(n,dc,...){rguman(n=1,nv=n,mut=dc[1],asym=dc[2], null=dc[3],method="exact",return.as.edgelist=TRUE)}, ) }else{ #For valued data, we're going to use adjacency matrices (sorry) #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(sapply(dat,cug.test,FUN=FUN,mode=mode,cmode=cmode,diag=diag, reps=reps,ignore.eval=ignore.eval,FUN.args=FUN.args)) else if(length(dim(dat))>2) return(apply(dat,1,cug.test,FUN=FUN,mode=mode,cmode=cmode,diag=diag, reps=reps,ignore.eval=ignore.eval,FUN.args=FUN.args)) #End pre-processing n<-NROW(dat) m<-NULL dc<-NULL mode<-match.arg(mode) cmode<-match.arg(cmode) getstat<-function(d){do.call(fun,c(list(d),FUN.args))} drawrep<-switch(cmode, size=function(n,...){rgraph(n,1,mode=mode,diag=diag,tprob=0.5)}, edges=switch(mode, digraph=function(n,...){g<-dat; g[upper.tri(g,diag=diag)|lower.tri(g)]<- sample(g[upper.tri(g,diag=diag)|lower.tri(g)]); g }, graph=function(n,...){g<-dat; g[upper.tri(g,diag=diag)]<-sample(g[upper.tri(g,diag=diag)]); g[lower.tri(g)]<-t(g)[lower.tri(g)]; g } ), dyad.census=function(n,...){g<-rewire.ud(dat,1)[1,,]; if(diag) diag(g)<-sample(diag(g)); g }, ) } #Set things up fun<-match.fun(FUN) if("mode"%in%names(formals(fun))) callmode<-TRUE else callmode<-FALSE if("diag"%in%names(formals(fun))) calldiag<-TRUE else calldiag<-FALSE if(callmode) FUN.args$mode<-mode if(calldiag) FUN.args$diag<-diag obs<-getstat(dat) #Draw replicate stats repstats<-vector() for(i in 1:reps){ repstats[i]<-getstat(drawrep(n=n,m=m,dc=dc)) } out<-list(obs.stat=obs,rep.stat=repstats,mode=mode,diag=diag,cmode=cmode, plteobs=mean(repstats<=obs),pgteobs=mean(repstats>=obs),reps=reps) class(out)<-"cug.test" out } #cugtest - Generate, print, and plot CUG (conditional uniform graph) test #objects. cugtest<-function(dat,FUN,reps=1000,gmode="digraph",cmode="density",diag=FALSE,g1=1,g2=2,...){ out<-list() #Pre-process the raw input dat<-as.sociomatrix.sna(dat) #End pre-processing #First, find the test value for fun on dat fun<-match.fun(FUN) out$testval<-fun(dat,g1=g1,g2=g2,...) #Next, determine on what we are conditioning if(cmode=="density"){ d<-c(gden(dat,g=g1,mode=gmode,diag=diag), gden(dat,g=g2,mode=gmode,diag=diag)) }else if(cmode=="ties"){ if(is.list(dat)){ tie1<-dat[[g1]] tie2<-dat[[g2]] }else{ tie1<-dat[g1,,] tie2<-dat[g2,,] } }else{ d<-c(0.5,0.5) } if(is.list(dat)){ #Get the graph sizes n1<-dim(dat[[g1]])[2] n2<-dim(dat[[g2]])[2] }else{ n1<-dim(dat)[2] n2<-dim(dat)[2] } #Now, perform reps replications on random recreations of the data out$dist<-vector(mode="numeric",length=reps) for(i in 1:reps){ if(cmode=="ties"){ #Generate random replicates dat1<-rgraph(n1,diag=diag,mode=gmode,tielist=tie1) dat2<-rgraph(n2,diag=diag,mode=gmode,tielist=tie2) }else{ dat1<-rgraph(n1,tprob=d[1],diag=diag,mode=gmode) dat2<-rgraph(n2,tprob=d[2],diag=diag,mode=gmode) } if(n1==n2){ #Combine into single structure datc<-array(dim=c(2,n1,n1)) datc[1,,]<-dat1 datc[2,,]<-dat2 }else datc<-list(dat1,dat2) out$dist[i]<-fun(datc,g1=1,g2=2,...) #Compute replicate stat } #Find p values out$pgreq<-mean(as.numeric(out$dist>=out$testval)) out$pleeq<-mean(as.numeric(out$dist<=out$testval)) class(out)<-c("cugtest","cug") out } #plot.cugtest - Plotting method for cugtest plot.cug.test<-function(x,main="Univariate CUG Test", sub=paste("Conditioning:",x$cmode,"Reps:",x$reps),...){ xl<-range(c(x$rep.stat,x$obs.stat)) hist(x$rep.stat,xlim=xl,xlab="CUG Replicates",prob=TRUE,main=main,sub=sub,...) abline(v=x$obs.stat,col=2,lwd=3) } #plot.cugtest - Plotting method for cugtest plot.cugtest<-function(x,mode="density",...){ if(mode=="density"){ plot(density(x$dist),main="Estimated Density of CUG Replications",xlab="Test Statistic",...) }else{ hist(x$dist,main="Histogram of CUG Replications",xlab="Test Statistic",...) } abline(v=x$testval,lty=2) } #plot.qaptest - Plotting method for qaptest plot.qaptest<-function(x,mode="density",...){ if(mode=="density"){ plot(density(x$dist),main="Estimated Density of QAP Replications",xlab="Test Statistic",...) }else{ hist(x$dist,main="Histogram of QAP Replications",xlab="Test Statistic",...) } abline(v=x$testval,lty=2) } #print.cug.test - Print method for cug.test print.cug.test<-function(x,...){ cat("\nUnivariate Conditional Uniform Graph Test\n\n") cat("Conditioning Method:",x$cmode,"\nGraph Type:",x$mode,"\nDiagonal Used:", x$diag,"\nReplications:",x$reps,"\n\n") cat("Observed Value:",x$obs.stat,"\n") cat("Pr(X>=Obs):",x$pgteobs,"\n") cat("Pr(X<=Obs):",x$plteobs,"\n\n") } #print.cugtest - Print method for cugtest print.cugtest<-function(x,...){ cat("\nCUG Test Results\n\n") cat("Estimated p-values:\n") cat("\tp(f(rnd) >= f(d)):",x$pgreq,"\n") cat("\tp(f(rnd) <= f(d)):",x$pleeq,"\n\n") } #print.qaptest - Print method for qaptest print.qaptest<-function(x,...){ cat("\nQAP Test Results\n\n") cat("Estimated p-values:\n") cat("\tp(f(perm) >= f(d)):",x$pgreq,"\n") cat("\tp(f(perm) <= f(d)):",x$pleeq,"\n\n") } #print.summary.cugtest - Print method for summary.cugtest print.summary.cugtest<-function(x,...){ cat("\nCUG Test Results\n\n") cat("Estimated p-values:\n") cat("\tp(f(rnd) >= f(d)):",x$pgreq,"\n") cat("\tp(f(rnd) <= f(d)):",x$pleeq,"\n") cat("\nTest Diagnostics:\n") cat("\tTest Value (f(d)):",x$testval,"\n") cat("\tReplications:",length(x$dist),"\n") cat("\tDistribution Summary:\n") cat("\t\tMin:\t",quantile(x$dist,probs=0,names=FALSE),"\n") cat("\t\t1stQ:\t",quantile(x$dist,probs=0.25,names=FALSE),"\n") cat("\t\tMed:\t",quantile(x$dist,probs=0.5,names=FALSE),"\n") cat("\t\tMean:\t",mean(x$dist),"\n") cat("\t\t3rdQ:\t",quantile(x$dist,probs=0.75,names=FALSE),"\n") cat("\t\tMax:\t",quantile(x$dist,probs=1,names=FALSE),"\n") cat("\n") } #print.summary.qaptest - Print method for summary.qaptest print.summary.qaptest<-function(x,...){ cat("\nQAP Test Results\n\n") cat("Estimated p-values:\n") cat("\tp(f(perm) >= f(d)):",x$pgreq,"\n") cat("\tp(f(perm) <= f(d)):",x$pleeq,"\n") cat("\nTest Diagnostics:\n") cat("\tTest Value (f(d)):",x$testval,"\n") cat("\tReplications:",length(x$dist),"\n") cat("\tDistribution Summary:\n") cat("\t\tMin:\t",quantile(x$dist,probs=0,names=FALSE),"\n") cat("\t\t1stQ:\t",quantile(x$dist,probs=0.25,names=FALSE),"\n") cat("\t\tMed:\t",quantile(x$dist,probs=0.5,names=FALSE),"\n") cat("\t\tMean:\t",mean(x$dist),"\n") cat("\t\t3rdQ:\t",quantile(x$dist,probs=0.75,names=FALSE),"\n") cat("\t\tMax:\t",quantile(x$dist,probs=1,names=FALSE),"\n") cat("\n") } #qaptest - Generate a QAP test object qaptest<-function(dat,FUN,reps=1000,...){ out<-list() #Coerce to sociomatrix form - rmperm is going to do that anyway.... dat<-as.sociomatrix(dat) #First, find the test value for fun on dat fun<-match.fun(FUN) out$testval<-fun(dat,...) #Now, perform reps replications on random permutations of the data out$dist<-vector(mode="numeric",length=reps) for(i in 1:reps){ out$dist[i]<-fun(rmperm(dat),...) } #Find p values out$pgreq<-mean(as.numeric(out$dist>=out$testval)) out$pleeq<-mean(as.numeric(out$dist<=out$testval)) class(out)<-c("qaptest","qap") out } #summary.cugtest - Summary method for cugtest summary.cugtest<-function(object, ...){ out<-object class(out)<-c("summary.cugtest",class(out)) out } #summary.qaptest - Summary method for qaptest summary.qaptest<-function(object, ...){ out<-object class(out)<-c("summary.qaptest",class(out)) out } sna/R/nli.R0000644000176200001440000005673414533477510012171 0ustar liggesusers###################################################################### # # nli.R # # copyright (c) 2004, Carter T. Butts # Last Modified 12/9/19 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines for calculating node-level indices. # # Contents: # betweenness # bonpow # closeness # degree # evcent # flowbet # graphcent # infocent # stresscent # ###################################################################### #betweenness - Find the betweenness centralities of network positions betweenness<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,cmode="directed",geodist.precomp=NULL,rescale=FALSE,ignore.eval=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],betweenness,g=1,nodes=nodes,gmode=gmode, diag=diag,tmaxdev=tmaxdev,cmode=cmode,geodist.precomp=geodist.precomp, rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing n<-attr(dat,"n") if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine #Note that I'm currently kludging some of these cases...could be iffy. if(!(cmode%in%c("directed","undirected"))){ star<-rbind(rep(1,n-1),2:n,rep(1,n-1)) if(gmode=="graph") star<-cbind(star,star[,c(2,1,3)]) attr(star,"n")<-n bet<-betweenness(star,g=1,nodes=1:n,gmode=gmode,diag=diag,tmaxdev=FALSE, cmode=cmode,geodist.precomp=NULL,rescale=FALSE,ignore.eval=ignore.eval) bet<-sum(max(bet)-bet) } if(gmode=="graph") cmode<-"undirected" bet<-switch(cmode, directed = (n-1)^2*(n-2), undirected = (n-1)^2*(n-2)/2, bet ) }else{ #First, set things up if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode=="undirected") #Symmetrize if need be dat<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) meas<-switch(cmode, undirected=0, directed=0, endpoints=1, proximalsrc=2, proximaltar=3, proximalsum=4, lengthscaled=5, linearscaled=6 ) if(!is.null(geodist.precomp)){ if(is.null(geodist.precomp$gdist) || is.null(geodist.precomp$counts) || is.null(geodist.precomp$predecessors)){ warning("Precomputed geodist output must include distance, count, and predecessor information (at least one of which was missing in geodist.precomp). Re-computing on the fly.\n") precomp<-FALSE }else precomp<-TRUE }else{ precomp<-FALSE } #Do the computation bet<-.Call("betweenness_R",dat,n,NROW(dat),meas,precomp,ignore.eval, geodist.precomp$gdist,geodist.precomp$counts,geodist.precomp$predecessors,PACKAGE="sna") if((cmode=="undirected")||(gmode=="graph")) bet<-bet/2 #Return the results if(rescale) bet<-bet/sum(bet) bet<-bet[nodes] } bet } #bonpow - Find the Bonacich power centrality scores of network positions bonpow<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,exponent=1,rescale=FALSE,tol=1e-7){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(sapply(dat[g],bonpow,g=1,nodes=nodes,gmode=gmode,diag=diag, tmaxdev=tmaxdev,exponent=exponent,rescale=rescale,tol=tol)) else if((length(g)>1)&&(length(dim(dat))>2)) return(apply(dat[g,,],1,bonpow,g=1,nodes=nodes,gmode=gmode,diag=diag, tmaxdev=tmaxdev,exponent=exponent,rescale=rescale,tol=tol)) #End pre-processing if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine if(gmode=="graph") ev<-(dim(dat)[2]-2)*sqrt(dim(dat)[2]/2) else ev<-sqrt(dim(dat)[2])*(dim(dat)[2]-1) }else{ #First, prepare the data if(length(dim(dat))>2) d<-dat[g,,] else d<-dat n<-dim(d)[1] if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(!diag) diag(d)<-0 #Make an identity matrix id<-matrix(rep(0,n*n),nrow=n) diag(id)<-1 #Do the computation ev<-apply(solve(id-exponent*d,tol=tol)%*%d,1,sum) #This works, when it works. #Apply the Bonacich scaling, by default (sum of squared ev=n) ev<-ev*sqrt(n/sum((ev)^2)) if(rescale) ev<-ev/sum(ev) ev[nodes] } ev } #closeness - Find the closeness centralities of network positions closeness<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,cmode="directed",geodist.precomp=NULL,rescale=FALSE,ignore.eval=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],closeness,g=1,nodes=nodes,gmode=gmode,diag=diag, tmaxdev=tmaxdev,cmode=cmode,geodist.precomp=geodist.precomp,rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing n<-attr(dat,"n") if(gmode=="graph"){ cmode<-switch(cmode, directed = "undirected", undirected = "undirected", suminvdir = "siminvundir", suminvundir = "suminvundir", "gil-schmidt" = "gil-schmidt" ) } if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine clo<-switch(cmode, directed = (n-1)*(1-1/n), #Depends on n subst for max distance undirected = (n-2)*(n-1)/(2*n-3), suminvdir = (n-1)*(n-1), suminvundir = n-1-n/2, "gil-schmidt" = (n-1)*(gmode=="digraph")+(n-2)/2*(gmode=="graph") ) }else{ #First, prepare the data if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode%in%c("undirected","suminvundir")) #Symmetrize if need be dat<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) #Do the computation if(is.null(geodist.precomp)) gd<-geodist(dat,count.paths=FALSE,predecessors=FALSE, ignore.eval=ignore.eval) else gd<-geodist.precomp diag(gd$gdist)<-NA clo<-switch(cmode, directed = (n-1)/rowSums(gd$gdist,na.rm=TRUE), undirected = (n-1)/rowSums(gd$gdist,na.rm=TRUE), suminvdir = rowSums(1/gd$gdist,na.rm=TRUE)/(n-1), suminvundir = rowSums(1/gd$gdist,na.rm=TRUE)/(n-1), "gil-schmidt" = apply(gd$gdist,1,function(z){ ids<-sum(1/z,na.rm=TRUE) r<-sum(z1)&&(length(dim(dat))>2)) return(apply(dat[g,,],1,flowbet,g=1,nodes=nodes,gmode=gmode,diag=diag, tmaxdev=tmaxdev,cmode=cmode,rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing n<-NROW(dat) if(ignore.eval) dat<-dat>0 if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine flo<-switch(cmode, #This only works if we assume unit capacities! rawflow=(n-1)^2*(n-2)/(1+(gmode=="graph")), normflow=n-1, fracflow=(n-1)^2*(n-2)/(1+(gmode=="graph")) ) }else{ #Wrapper for the Edmonds-Karp max-flow algorithm mflow<-function(x,src,snk){ .C("maxflow_EK_R",as.double(x),as.integer(NROW(x)),as.integer(src-1), as.integer(snk-1),flow=as.double(0),NAOK=TRUE,PACKAGE="sna")$flow } #Start by obtaining all-pairs max-solutions maxflo<-matrix(Inf,n,n) if(gmode=="digraph"){ for(i in 1:n) for(j in 1:n) if(i!=j) maxflo[i,j]<-mflow(dat,i,j) }else{ for(i in 1:n) for(j in (i:n)[-1]) maxflo[i,j]<-mflow(dat,i,j) maxflo[lower.tri(maxflo)]<-t(maxflo)[lower.tri(maxflo)] } if(cmode=="normflow"){ flo<-maxflo diag(flo)<-0 maxoflo<-rep(0,n) for(i in 1:n) maxoflo[i]<-sum(flo[-i,-i]) } #Compute the flow betweenness scores flo<-rep(0,n) for(i in 1:n){ for(j in 1:n) for(k in 1:n) if((i!=j)&&(i!=k)&&(j!=k)&&((gmode=="digraph")||j0)){ redflow<-mflow(dat[-i,-i],j-(j>i),k-(k>i)) flo[i]<-switch(cmode, rawflow=flo[i]+maxflo[j,k]-redflow, normflow=flo[i]+maxflo[j,k]-redflow, fracflow=flo[i]+(maxflo[j,k]-redflow)/maxflo[j,k] ) } } if(cmode=="normflow") flo<-flo/maxoflo*(1+(gmode=="graph")) if(rescale) flo<-flo/sum(flo) if(is.null(nodes)) nodes<-1:n flo<-flo[nodes] } flo } #gilschmidt - Compute the Gil-Schmidt power centrality index gilschmidt <- function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,normalize=TRUE){ #Pre-process the input dat<-as.edgelist.sna(dat) if(is.list(dat)){ return(sapply(dat[g],gilschmidt,normalize=normalize)) } #End pre-processing g<-dat n<-attr(g,"n") #See if we only need to return the theoretical max deviation from the maximum if(tmaxdev){ if(gmode=="digraph") return(n-1) else return((n-2)/2) } #No such luck. Well, let's compute. gs<-.C("gilschmidt_R",as.double(g),as.integer(n), as.integer(NROW(g)), scores=double(n), as.integer(normalize), PACKAGE="sna", NAOK=TRUE)$scores gs[is.nan(gs)]<-0 if(is.null(nodes)) nodes<-1:n gs[nodes] } #graphcent - Find the graph centralities of network positions graphcent<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,cmode="directed",geodist.precomp=NULL,rescale=FALSE,ignore.eval=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],graphcent,g=1,nodes=nodes,gmode=gmode,diag=diag, tmaxdev=tmaxdev,cmode=cmode,geodist.precomp=geodist.precomp,rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing if(gmode=="graph") #If the data is symmetric, treat it as such cmode<-"undirected" n<-attr(dat,"n") if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine gc<-switch(cmode, directed = (n-1)*(1-1/n), #Depends on n subst for infinite distance undirected = (n-1)/2 ) }else{ #First, prepare the data if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode=="undirected") #Symmetrize if need be dat<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) #Do the computation if(is.null(geodist.precomp)) gd<-geodist(dat,count.paths=FALSE,predecessors=FALSE, ignore.eval=ignore.eval) else gd<-geodist.precomp gc<-apply(gd$gdist,1,max) gc<-1/gc if(rescale) gc<-gc/sum(gc) gc<-gc[nodes] } #Return the results gc } # infocent - Find actor information centrality scores # Wasserman & Faust pp. 192-197; based on code generously submitted by David # Barron (thanks!) and tweaked by myself to enable compatibility with the # centralization() routine. infocent <- function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,cmode="weak",tmaxdev=FALSE,rescale=FALSE,tol=1e-20){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(sapply(dat[g],infocent,g=1,nodes=nodes,gmode=gmode,diag=diag, cmode=cmode,tmaxdev=tmaxdev,rescale=rescale,tol=tol)) else if((length(g)>1)&&(length(dim(dat))>2)) return(apply(dat[g,,],1,infocent,g=1,nodes=nodes,gmode=gmode,diag=diag, cmode=cmode,tmaxdev=tmaxdev,rescale=rescale,tol=tol)) #End pre-processing if(tmaxdev){ #If necessary, return the theoretical maximum deviation #We don't know the real maximum value...return the lone dyad instead m<-matrix(0,nrow=dim(dat)[2],ncol=dim(dat)[2]) m[1,2]<-1 m[2,1]<-1 IC<-infocent(m,1,rescale=rescale) #Get ICs for dyad cent<-sum(max(IC)-IC,na.rm=TRUE) #Return the theoretical max deviation }else{ #First, prepare the data if(length(dim(dat))>2) m<-dat[g,,] else m<-dat if(is.null(nodes)) #Set up node list, if needed nodes<-1:dim(dat)[2] if(sum(m != t(m),na.rm=TRUE) > 0) #test to see if directed m <- symmetrize(m,rule=cmode) #if not, we have to symmetrize... n <- dim(m)[1] if(!diag) diag(m)<-NA # if diag=F set diagonal to NA iso <- is.isolate(m,1:n,diag=diag) # check for isolates ix <- which(!iso) m <- m[ix,ix] # remove any isolates (can't invert A otherwise) A<-1-m A[m==0] <- 1 diag(A) <- 1 + apply(m, 1, sum, na.rm=TRUE) Cn <- solve(A,tol=tol) Tr <- sum(diag(Cn)) R <- apply(Cn, 1, sum) IC <- 1/(diag(Cn) + (Tr - 2*R)/n) # Actor information centrality #Add back the isolates cent<-rep(0,n) cent[ix]<-IC #Rescale if needed if(rescale) cent<-cent/sum(cent) #Subset as requested cent<-cent[nodes] } #Return the result cent } loadcent<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,cmode="directed",geodist.precomp=NULL,rescale=FALSE,ignore.eval=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],loadcent,g=1,nodes=nodes,gmode=gmode, diag=diag,tmaxdev=tmaxdev,cmode=cmode,geodist.precomp=geodist.precomp, rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing n<-attr(dat,"n") if(gmode=="graph") #If the data is symmetric, treat it as such cmode<-"undirected" if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine lc<-switch(cmode, directed = (n-1)^2*(n-2), undirected = (n-1)^2*(n-2)/2 ) }else{ #First, set things up if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode=="undirected") #Symmetrize if need be dat<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) else dat<-gt(dat,return.as.edgelist=TRUE) #Transpose the input digraph if(!is.null(geodist.precomp)){ if(is.null(geodist.precomp$gdist) || is.null(geodist.precomp$counts) || is.null(geodist.precomp$predecessors)){ warning("Precomputed geodist output must include distance, count, and predecessor information (at least one of which was missing in geodist.precomp). Re-computing on the fly.\n") precomp<-FALSE }else precomp<-TRUE }else{ precomp<-FALSE } #Do the computation (we use the betweenness routine, oddly) lc<-.Call("betweenness_R",dat,n,NROW(dat),8,precomp,ignore.eval, geodist.precomp$gdist,geodist.precomp$counts,geodist.precomp$predecessors,PACKAGE="sna") #Return the results if(rescale) lc<-lc/sum(lc) lc<-lc[nodes] } lc } #prestige - Find actor prestige scores from one of several measures prestige<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,cmode="indegree",tmaxdev=FALSE,rescale=FALSE,tol=1e-7){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],prestige,g=1,nodes=nodes,gmode=gmode,diag=diag, cmode=cmode,tmaxdev=tmaxdev,rescale=rescale,tol=tol)) #End pre-processing n<-attr(dat,"n") if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine h<-matrix(nrow=0,ncol=3) attr(h,"n")<-n if(cmode=="indegree") p<-degree(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="indegree.rownorm") p<-degree(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="indegree.rowcolnorm") p<-degree(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="eigenvector") p<-evcent(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag) else if(cmode=="eigenvector.rownorm") p<-evcent(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag) else if(cmode=="eigenvector.colnorm") p<-evcent(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag) else if(cmode=="eigenvector.rowcolnorm") p<-evcent(dat=h,g=1,tmaxdev=TRUE,gmode=gmode,diag=diag) else if(cmode=="domain"){ p<-(n-1)^2 }else if(cmode=="domain.proximity"){ p<-(n-1)^2 }else stop(paste("Cmode",cmode,"unknown.\n")) }else{ #First, prepare the data if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode%in%c("eigenvector")){ td<-dat if(!diag){ td<-td[td[,1]!=td[,2],c(2,1,3),drop=FALSE] attr(td,"n")<-attr(dat,"n") } }else if(cmode%in%c("indegree.rownorm","indegree.colnorm","indegree.rowcolnorm", "eigenvector.rownorm","eigenvector.colnorm","eigenvector.rowcolnorm", "domain","domain.proximity")){ d<-dat if(!diag){ d<-d[d[,1]!=d[,2],,drop=FALSE] attr(d,"n")<-attr(dat,"n") } } #Now, perform the computation if(cmode=="indegree") p<-degree(dat=dat,g=g,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="indegree.rownorm") p<-degree(dat=make.stochastic(d,mode="row"),g=1,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="indegree.rowcolnorm") p<-degree(dat=make.stochastic(d,mode="rowcol"),g=1,gmode=gmode,diag=diag,cmode="indegree",rescale=FALSE) else if(cmode=="eigenvector") p<-evcent(td) else if(cmode=="eigenvector.rownorm") p<-eigen(t(make.stochastic(d,mode="row")))$vector[,1] else if(cmode=="eigenvector.colnorm") p<-eigen(t(make.stochastic(d,mode="col")))$vector[,1] else if(cmode=="eigenvector.rowcolnorm") p<-eigen(t(make.stochastic(d,mode="rowcol")))$vector[,1] else if(cmode=="domain"){ r<-reachability(d) p<-apply(r,2,sum)-1 }else if(cmode=="domain.proximity"){ g<-geodist(d) p<-(apply(g$counts>0,2,sum)-1)^2/(apply((g$counts>0)*(g$gdist),2,sum)*(n-1)) p[is.nan(p)]<-0 }else stop(paste("Cmode",cmode,"unknown.\n")) if(rescale) p<-p/sum(p) p<-p[nodes] } p } #stresscent - Find the stress centralities of network positions stresscent<-function(dat,g=1,nodes=NULL,gmode="digraph",diag=FALSE,tmaxdev=FALSE,cmode="directed",geodist.precomp=NULL,rescale=FALSE,ignore.eval=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(sapply(dat[g],stresscent,g=1,nodes=nodes,gmode=gmode, diag=diag,tmaxdev=tmaxdev,cmode=cmode,geodist.precomp=geodist.precomp, rescale=rescale,ignore.eval=ignore.eval)) #End pre-processing n<-attr(dat,"n") if(gmode=="graph") #If the data is symmetric, treat it as such cmode<-"undirected" if(tmaxdev){ #We got off easy: just return the theoretical maximum deviation for the centralization routine str<-switch(cmode, directed = (n-1)^2*(n-2), undirected = (n-1)^2*(n-2)/2 ) }else{ #First, set things up if(is.null(nodes)) #Set up node list, if needed nodes<-1:n if(cmode=="undirected") #Symmetrize if need be dat<-symmetrize(dat,rule="weak",return.as.edgelist=TRUE) if(!is.null(geodist.precomp)){ if(is.null(geodist.precomp$gdist) || is.null(geodist.precomp$counts) || is.null(geodist.precomp$predecessors)){ warning("Precomputed geodist output must include distance, count, and predecessor information (at least one of which was missing in geodist.precomp). Re-computing on the fly.\n") precomp<-FALSE }else precomp<-TRUE }else{ precomp<-FALSE } #Do the computation (we use the betweenness routine, oddly) str<-.Call("betweenness_R",dat,n,NROW(dat),7,precomp,ignore.eval, geodist.precomp$gdist,geodist.precomp$counts,geodist.precomp$predecessors,PACKAGE="sna") if(cmode=="undirected") str<-str/2 #Return the results if(rescale) str<-str/sum(str) str<-str[nodes] } str } sna/R/zzz.R0000755000176200001440000000172614533477445012245 0ustar liggesusers###################################################################### # # zzz.R # # copyright (c) 2004, Carter T. Butts # Last Modified 2/28/13 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # .onLoad is run when the package is loaded with library(sna) # ###################################################################### .onLoad <- function(libname, pkgname){ library.dynam("sna", package=pkgname, lib.loc=libname) } .onAttach <- function(libname, pkgname){ temp<-packageDescription("sna") msg<-paste(temp$Package,": ",temp$Title,"\n", "Version ",temp$Version, " created on ", temp$Date,".\n", sep="") msg<-paste(msg,"copyright (c) 2005, Carter T. Butts, University of California-Irvine\n",sep="") msg<-paste(msg,'For citation information, type citation("sna").\n') msg<-paste(msg,'Type help(package="sna") to get started.\n') packageStartupMessage(msg) } sna/R/visualization.R0000644000176200001440000017537114533477453014315 0ustar liggesusers###################################################################### # # visualization.R # # copyright (c) 2004, Carter T. Butts # Last Modified 1/23/23 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains various routines related to graph visualization. # # Contents: # gplot # gplot.arrow # gplot.layout.adj # gplot.layout.circle # gplot.layout.circrand # gplot.layout.eigen # gplot.layout.fruchtermanreingold # gplot.layout.geodist # gplot.layout.hall # gplot.layout.kamadakawai # gplot.layout.mds # gplot.layout.princoord # gplot.layout.random # gplot.layout.rmds # gplot.layout.segeo # gplot.layout.seham # gplot.layout.spring # gplot.layout.springrepulse # gplot.layout.target # gplot.loop # gplot.target # gplot.vertex # gplot3d # gplot3d.arrow # gplot3d.layout.adj # gplot3d.layout.eigen # gplot3d.layout.fruchtermanreingold # gplot3d.layout.geodist # gplot3d.layout.hall # gplot3d.layout.kamadakawai # gplot3d.layout.mds # gplot3d.layout.princoord # gplot3d.layout.random # gplot3d.layout.rmds # gplot3d.layout.segeo # gplot3d.layout.seham # gplot3d.loop # plot.sociomatrix # sociomatrixplot # ###################################################################### #gplot - Two-dimensional graph visualization gplot<-function(dat,g=1,gmode="digraph",diag=FALSE,label=NULL,coord=NULL,jitter=TRUE,thresh=0,thresh.absval=TRUE,usearrows=TRUE,mode="fruchtermanreingold",displayisolates=TRUE,interactive=FALSE,interact.bycomp=FALSE,xlab=NULL,ylab=NULL,xlim=NULL,ylim=NULL,pad=0.2,label.pad=0.5,displaylabels=!is.null(label),boxed.labels=FALSE,label.pos=0,label.bg="white",vertex.enclose=FALSE,vertex.sides=NULL,vertex.rot=0,arrowhead.cex=1,label.cex=1,loop.cex=1,vertex.cex=1,edge.col=1,label.col=1,vertex.col=NULL,label.border=1,vertex.border=1,edge.lty=NULL,edge.lty.neg=2,label.lty=NULL,vertex.lty=1,edge.lwd=0,label.lwd=par("lwd"),edge.len=0.5,edge.curve=0.1,edge.steps=50,loop.steps=20,object.scale=0.01,uselen=FALSE,usecurve=FALSE,suppress.axes=TRUE,vertices.last=TRUE,new=TRUE,layout.par=NULL,...){ #Turn the annoying locator bell off, and remove recursion limit bellstate<-options()$locatorBell expstate<-options()$expression on.exit(options(locatorBell=bellstate,expression=expstate)) options(locatorBell=FALSE,expression=Inf) #Create a useful interval inclusion operator "%iin%"<-function(x,int) (x>=int[1])&(x<=int[2]) #Extract the graph to be displayed and obtain its properties d<-as.edgelist.sna(dat,force.bipartite=(gmode=="twomode")) if(is.list(d)) d<-d[[g]] n<-attr(d,"n") if(is.null(label)){ if(displaylabels!=TRUE) displaylabels<-FALSE if(!is.null(attr(d,"vnames"))) label<-attr(d,"vnames") else if((gmode=="twomode")&&(!is.null(attr(d,"bipartite")))) label<-c(paste("R",1:attr(d,"bipartite"),sep=""), paste("C",(attr(d,"bipartite")+1):n,sep="")) else{ label<-1:n } } #Make adjustments for gmode, if required, and set up other defaults if(gmode=="graph"){ usearrows<-FALSE } else if ((gmode=="twomode")&&(!is.null(attr(d,"bipartite")))) { #For two-mode graphs, make columns blue and 4-sided (versus #red and 50-sided) #If defaults haven't been modified Rn <- attr(d,"bipartite") if (is.null(vertex.col)) vertex.col <- c(rep(2,Rn),rep(4,n-Rn)) if (is.null(vertex.sides)) vertex.sides <- c(rep(50,Rn),rep(4,n-Rn)) } if (is.null(vertex.col)) vertex.col <- 2 if (is.null(vertex.sides)) vertex.sides <- 50 #Remove missing edges d<-d[!is.na(d[,3]),,drop=FALSE] #Set edge line types if (is.null(edge.lty)){ #If unset, assume 1 for pos, edge.lty.neg for neg edge.lty<-rep(1,NROW(d)) if(!is.null(edge.lty.neg)) #If NULL, just ignore it edge.lty[d[,3]<0]<-edge.lty.neg }else{ #If set, see what we were given... if(length(edge.lty)!=NROW(d)){ #Not specified per edge, so modify edge.lty<-rep(edge.lty,NROW(d)) if(!is.null(edge.lty.neg)) #If given neg value, use it edge.lty[d[,3]<0]<-edge.lty.neg }else{ #Might modify negative edges if(!is.null(edge.lty.neg)) edge.lty[d[,3]<0]<-edge.lty.neg } } #Save a copy of d, in case values are needed d.raw<-d #Dichotomize d if(thresh.absval) d<-d[abs(d[,3])>thresh,,drop=FALSE] #Threshold by absolute value else d<-d[d[,3]>thresh,,drop=FALSE] #Threshold by signed value attr(d,"n")<-n #Restore "n" to d #Determine coordinate placement if(!is.null(coord)){ #If the user has specified coords, override all other considerations x<-coord[,1] y<-coord[,2] }else{ #Otherwise, use the specified layout function layout.fun<-try(match.fun(paste("gplot.layout.",mode,sep="")),silent=TRUE) if(inherits(layout.fun,"try-error")) stop("Error in gplot: no layout function for mode ",mode) temp<-layout.fun(d,layout.par) x<-temp[,1] y<-temp[,2] } #Jitter the coordinates if need be if(jitter){ x<-jitter(x) y<-jitter(y) } #Which nodes should we use? use<-displayisolates|(!is.isolate(d,ego=1:n)) #Deal with axis labels if(is.null(xlab)) xlab="" if(is.null(ylab)) ylab="" #Set limits for plotting region if(is.null(xlim)) xlim<-c(min(x[use])-pad,max(x[use])+pad) #Save x, y limits if(is.null(ylim)) ylim<-c(min(y[use])-pad,max(y[use])+pad) xrng<-diff(xlim) #Force scale to be symmetric yrng<-diff(ylim) xctr<-(xlim[2]+xlim[1])/2 #Get center of plotting region yctr<-(ylim[2]+ylim[1])/2 if(xrng0){ if(length(dim(edge.col))==2) #Coerce edge.col/edge.lty to vector form edge.col<-edge.col[d[,1:2]] else edge.col<-rep(edge.col,length=NROW(d)) if(length(dim(edge.lty))==2) edge.lty<-edge.lty[d[,1:2]] else edge.lty<-rep(edge.lty,length=NROW(d)) if(length(dim(edge.lwd))==2){ edge.lwd<-edge.lwd[d[,1:2]] e.lwd.as.mult<-FALSE }else{ if(length(edge.lwd)==1) e.lwd.as.mult<-TRUE else e.lwd.as.mult<-FALSE edge.lwd<-rep(edge.lwd,length=NROW(d)) } if(!is.null(edge.curve)){ if(length(dim(edge.curve))==2){ edge.curve<-edge.curve[d[,1:2]] e.curv.as.mult<-FALSE }else{ if(length(edge.curve)==1) e.curv.as.mult<-TRUE else e.curv.as.mult<-FALSE edge.curve<-rep(edge.curve,length=NROW(d)) } }else edge.curve<-rep(0,length=NROW(d)) dist<-((x[d[,1]]-x[d[,2]])^2+(y[d[,1]]-y[d[,2]])^2)^0.5 #Get the inter-point distances for curves tl<-d*dist #Get rescaled edge lengths tl.max<-max(tl) #Get maximum edge length for(i in 1:NROW(d)) if(use[d[i,1]]&&use[d[i,2]]){ #Plot edges for displayed vertices px0<-c(px0,as.double(x[d[i,1]])) #Store endpoint coordinates py0<-c(py0,as.double(y[d[i,1]])) px1<-c(px1,as.double(x[d[i,2]])) py1<-c(py1,as.double(y[d[i,2]])) e.toff<-c(e.toff,vertex.radius[d[i,1]]) #Store endpoint offsets e.hoff<-c(e.hoff,vertex.radius[d[i,2]]) e.col<-c(e.col,edge.col[i]) #Store other edge attributes e.type<-c(e.type,edge.lty[i]) if(edge.lwd[i]>0){ if(e.lwd.as.mult) e.lwd<-c(e.lwd,edge.lwd[i]*d.raw[i,3]) else e.lwd<-c(e.lwd,edge.lwd[i]) }else e.lwd<-c(e.lwd,1) e.diag<-c(e.diag,d[i,1]==d[i,2]) #Is this a loop? e.rad<-c(e.rad,vertex.radius[d[i,1]]*loop.cex[d[i,1]]) if(uselen){ #Should we base curvature on interpoint distances? if(tl[i]>0){ e.len<-dist[i]*tl.max/tl[i] e.curv<-c(e.curv,edge.len*sqrt((e.len/2)^2-(dist[i]/2)^2)) }else{ e.curv<-c(e.curv,0) } }else{ #Otherwise, use prespecified edge.curve if(e.curv.as.mult) #If it's a scalar, multiply by edge str e.curv<-c(e.curv,edge.curve[i]*dist[i]) else e.curv<-c(e.curv,edge.curve[i]) } } } #Plot loops for the diagonals, if diag==TRUE, rotating wrt center of mass if(diag&&(length(px0)>0)&&sum(e.diag>0)){ #Are there any loops present? gplot.loop(as.vector(px0)[e.diag],as.vector(py0)[e.diag], length=1.5*baserad*arrowhead.cex,angle=25,width=e.lwd[e.diag]*baserad/10,col=e.col[e.diag],border=e.col[e.diag],lty=e.type[e.diag],offset=e.hoff[e.diag],edge.steps=loop.steps,radius=e.rad[e.diag],arrowhead=usearrows,xctr=mean(x[use]),yctr=mean(y[use])) } #Plot standard (i.e., non-loop) edges if(length(px0)>0){ #If edges are present, remove loops from consideration px0<-px0[!e.diag] py0<-py0[!e.diag] px1<-px1[!e.diag] py1<-py1[!e.diag] e.curv<-e.curv[!e.diag] e.lwd<-e.lwd[!e.diag] e.type<-e.type[!e.diag] e.col<-e.col[!e.diag] e.hoff<-e.hoff[!e.diag] e.toff<-e.toff[!e.diag] e.rad<-e.rad[!e.diag] } if(!usecurve&!uselen){ #Straight-line edge case if(length(px0)>0) gplot.arrow(as.vector(px0),as.vector(py0),as.vector(px1),as.vector(py1), length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows,edge.steps=edge.steps) #AHM edge.steps needed for lty to work }else{ #Curved edge case if(length(px0)>0){ gplot.arrow(as.vector(px0),as.vector(py0),as.vector(px1),as.vector(py1), length=2*baserad*arrowhead.cex,angle=20,col=e.col,border=e.col,lty=e.type,width=e.lwd*baserad/10,offset.head=e.hoff,offset.tail=e.toff,arrowhead=usearrows,curve=e.curv,edge.steps=edge.steps) } } #Plot vertices now, if we haven't already done so if(vertices.last){ #AHM feature start: enclose vertex polygons with circles (makes labels and arrows look better connected) if(vertex.enclose) gplot.vertex(x[use],y[use],radius=vertex.radius[use], sides=50,col="#FFFFFFFF",border=vertex.border[use],lty=vertex.lty[use]) #AHM feature end: enclose vertex polygons with circles (makes labels and arrows look better connected) gplot.vertex(x[use],y[use],radius=vertex.radius[use], sides=vertex.sides[use],col=vertex.col[use],border=vertex.border[use],lty=vertex.lty[use],rot=vertex.rot[use]) } #Plot vertex labels, if needed if(displaylabels&(!all(label==""))&(!all(use==FALSE))){ if (label.pos==0){ xhat <- yhat <- rhat <- rep(0,n) #Set up xoff yoff and roff when we get odd vertices xoff <- x[use]-mean(x[use]) yoff <- y[use]-mean(y[use]) roff <- sqrt(xoff^2+yoff^2) #Loop through vertices for (i in (1:n)[use]){ #Find all in and out ties that aren't loops ij <- unique(c(d[d[,2]==i&d[,1]!=i,1],d[d[,1]==i&d[,2]!=i,2])) ij.n <- length(ij) if (ij.n>0) { #Loop through all ties and add each vector to label direction for (j in ij){ dx <- x[i]-x[j] dy <- y[i]-y[j] dr <- sqrt(dx^2+dy^2) xhat[i] <- xhat[i]+dx/dr yhat[i] <- yhat[i]+dy/dr } #Take the average of all the ties xhat[i] <- xhat[i]/ij.n yhat[i] <- yhat[i]/ij.n rhat[i] <- sqrt(xhat[i]^2+yhat[i]^2) if (rhat[i]!=0) { # normalize direction vector xhat[i] <- xhat[i]/rhat[i] yhat[i] <- yhat[i]/rhat[i] } else { #if no direction, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } } else { #if no ties, make xhat and yhat away from center xhat[i] <- xoff[i]/roff[i] yhat[i] <- yoff[i]/roff[i] } if (xhat[i]==0) xhat[i] <- .01 #jitter to avoid labels on points if (yhat[i]==0) yhat[i] <- .01 } xhat <- xhat[use] yhat <- yhat[use] } else if (label.pos<5) { xhat <- switch(label.pos,0,-1,0,1) yhat <- switch(label.pos,-1,0,1,0) } else if (label.pos==6) { xoff <- x[use]-mean(x[use]) yoff <- y[use]-mean(y[use]) roff <- sqrt(xoff^2+yoff^2) xhat <- xoff/roff yhat <- yoff/roff } else { xhat <- 0 yhat <- 0 } #AHM bugfix start: label attributes weren't being filled out or restricted with [use] # os<-par()$cxy*label.cex #AHM not used and now chokes on properly filled label.cex lw<-strwidth(label[use],cex=label.cex[use])/2 lh<-strheight(label[use],cex=label.cex[use])/2 if(boxed.labels){ rect(x[use]+xhat*vertex.radius[use]-(lh*label.pad+lw)*((xhat<0)*2+ (xhat==0)*1), y[use]+yhat*vertex.radius[use]-(lh*label.pad+lh)*((yhat<0)*2+ (yhat==0)*1), x[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)*2+ (xhat==0)*1), y[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)*2+ (yhat==0)*1), col=label.bg[use],border=label.border[use],lty=label.lty[use],lwd=label.lwd[use]) } text(x[use]+xhat*vertex.radius[use]+(lh*label.pad+lw)*((xhat>0)-(xhat<0)), y[use]+yhat*vertex.radius[use]+(lh*label.pad+lh)*((yhat>0)-(yhat<0)), label[use],cex=label.cex[use],col=label.col[use],offset=0) } #AHM bugfix end: label attributes weren't being filled out or restricted with [use] #If interactive, allow the user to mess with things if((interactive|interact.bycomp)&&((length(x)>0)&&(!all(use==FALSE)))){ #AHM bugfix: interact.bycomp wouldn't fire without interactive also being set #Set up the text offset increment os<-c(0.2,0.4)*par()$cxy #Get the location for text messages, and write to the screen textloc<-c(min(x[use])-pad,max(y[use])+pad) tm<-"Select a vertex to move, or click \"Finished\" to end." tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) #Print the initial instruction fm<-"Finished" finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the click location clickpos<-unlist(locator(1)) #If the click is in the "finished" box, end our little game. Otherwise, #relocate a vertex and redraw. if((clickpos[1]%iin%finbx)&&(clickpos[2]%iin%finby)){ cl<-match.call() #Get the args of the current function cl$interactive<-FALSE #Turn off interactivity cl$coord<-cbind(x,y) #Set the coordinates cl$dat<-dat #"Fix" the data array return(eval(cl)) #Execute the function and return }else{ #Figure out which vertex was selected clickdis<-sqrt((clickpos[1]-x[use])^2+(clickpos[2]-y[use])^2) selvert<-match(min(clickdis),clickdis) #Create usable labels, if the current ones aren't if(all(label=="")) label<-1:n #Clear out the old message, and write a new one rect(textloc[1],textloc[2]-tmh/2,textloc[1]+tmw,textloc[2]+tmh/2, border="white",col="white") if (interact.bycomp) tm <- "Where should I move this component?" else tm<-"Where should I move this vertex?" tmh<-strheight(tm) tmw<-strwidth(tm) text(textloc[1],textloc[2],tm,adj=c(0,0.5)) fm<-paste("Vertex",label[use][selvert],"selected") finx<-c(textloc[1],textloc[1]+strwidth(fm)) finy<-c(textloc[2]-3*tmh-strheight(fm)/2,textloc[2]-3*tmh+ strheight(fm)/2) finbx<-finx+c(-os[1],os[1]) finby<-finy+c(-os[2],os[2]) rect(finbx[1],finby[1],finbx[2],finby[2],col="white") text(finx[1],mean(finy),fm,adj=c(0,0.5)) #Get the destination for the new vertex clickpos<-unlist(locator(1)) #Set the coordinates accordingly if (interact.bycomp) { dx <- clickpos[1]-x[use][selvert] dy <- clickpos[2]-y[use][selvert] comp.mem <- component.dist(d,connected="weak")$membership same.comp <- comp.mem[use]==comp.mem[use][selvert] x[use][same.comp] <- x[use][same.comp]+dx y[use][same.comp] <- y[use][same.comp]+dy } else { x[use][selvert]<-clickpos[1] y[use][selvert]<-clickpos[2] } #Iterate (leaving interactivity on) cl<-match.call() #Get the args of the current function cl$coord<-cbind(x,y) #Set the coordinates cl$dat<-dat #"Fix" the data array return(eval(cl)) #Execute the function and return } } #Return the vertex positions, should they be needed invisible(cbind(x,y)) } #gplot.arrow - Custom arrow-drawing method for gplot gplot.arrow<-function(x0,y0,x1,y1,length=0.1,angle=20,width=0.01,col=1,border=1,lty=1,offset.head=0,offset.tail=0,arrowhead=TRUE,curve=0,edge.steps=50,...){ if(length(x0)==0) #Leave if there's nothing to do return(); #Introduce a function to make coordinates for a single polygon make.coords<-function(x0,y0,x1,y1,ahangle,ahlen,swid,toff,hoff,ahead,curve,csteps,lty){ if (lty=="blank"|lty==0) return(c(NA,NA)) #AHM leave if lty is "blank" slen<-sqrt((x0-x1)^2+(y0-y1)^2) #Find the total length #AHM begin code to fix csteps so all dashed lines look the same xlenin=(abs(x0-x1)/(par()$usr[2]-par()$usr[1]))*par()$pin[1] ylenin=(abs(y0-y1)/(par()$usr[4]-par()$usr[3]))*par()$pin[2] csteps=csteps*sqrt(xlenin^2+ylenin^2) #AHM end code to fix csteps so all dashed lines look the same #AHM begin code to decode lty (0=blank, 1=solid (default), 2=dashed, 3=dotted, 4=dotdash, 5=longdash, 6=twodash) if (is.character(lty)){ lty <- switch (lty,blank=0,solid=1,dashed=2,dotted=3,dotdash=4,longdash=5,twodash=6,lty) } else { lty <- as.character(lty) } if (is.na(as.integer(lty))) lty <- "10" if (as.integer(lty)<10) lty <- c("01","10","44", "13", "1343", "73", "2262")[as.integer(lty)+1] #AHM end code to decode lty if(curve==0<y=="10"){ #Straight, solid edges if(ahead){ coord<-rbind( #Produce a "generic" version w/head c(-swid/2,toff), c(-swid/2,slen-0.5*ahlen-hoff), c(-swid/2-ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(0,slen-hoff), c(swid/2+ahlen*sin(ahangle),slen-ahlen*cos(ahangle)-hoff), c(swid/2,slen-0.5*ahlen-hoff), c(swid/2,toff), c(NA,NA) ) }else{ coord<-rbind( #Produce a "generic" version w/out head c(-swid/2,toff), c(-swid/2,slen-hoff), c(swid/2,slen-hoff), c(swid/2,toff), c(NA,NA) ) } }else{ #Curved or non-solid edges (requires incremental polygons) theta<-atan2(y1-y0,x1-x0) #Adjust curved arrows to make start/stop points meet at edge of polygon x0<-x0+cos(theta)*toff x1<-x1-cos(theta)*hoff y0<-y0+sin(theta)*toff y1<-y1-sin(theta)*hoff slen<-sqrt((x0-x1)^2+(y0-y1)^2) #AHM begin toff/hoff bugfix and simplification of curve code (elimination of toff and hoff) if(ahead){ inc<-(0:csteps)/csteps coord<-rbind( cbind( -curve*(1-(2*(inc-0.5))^2)-swid/2,inc*(slen-ahlen*0.5)), c(-swid/2+ahlen*sin(-ahangle-(curve>0)*pi/16), slen-ahlen*cos(-ahangle-(curve>0)*pi/16)), c(0,slen), c(swid/2+ahlen*sin(ahangle-(curve>0)*pi/16), slen-ahlen*cos(ahangle-(curve>0)*pi/16)), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2,rev(inc)*(slen-ahlen*0.5)), c(NA,NA) ) }else{ inc<-(0:csteps)/csteps coord<-rbind( cbind(-curve*(1-(2*(inc-0.5))^2)-swid/2, inc*slen), cbind(-curve*(1-(2*(rev(inc)-0.5))^2)+swid/2, rev(inc)*slen), c(NA,NA) ) } } #AHM end bugfix and simplification of curve code theta<-atan2(y1-y0,x1-x0)-pi/2 #Rotate about origin rmat<-rbind(c(cos(theta),sin(theta)),c(-sin(theta),cos(theta))) coord<-coord%*%rmat coord[,1]<-coord[,1]+x0 #Translate to (x0,y0) coord[,2]<-coord[,2]+y0 #AHM begin code to allow for lty other than 1 if (lty!="10"){ #Straight, solid edges inc <- 1 lty.i <- 1 lty.n <- nchar(lty) inc.solid=as.integer(substr(lty,lty.i,lty.i)) inc.blank=as.integer(substr(lty,lty.i+1,lty.i+1)) coord.n <- dim(coord)[1] coord2 <- NULL while (inc<(csteps-inc.solid-inc.blank+1)) { coord2 <- rbind(coord2,coord[inc:(inc+inc.solid),], coord[(coord.n-inc.solid-inc):(coord.n-inc),],c(NA,NA)) inc <- inc+inc.solid+inc.blank lty.i=lty.i+2 if (lty.i>lty.n) lty.i <- 1 } if (inc<(coord.n-inc)) coord2 <- rbind(coord2,coord[inc:(coord.n-inc),],c(NA,NA)) coord <- coord2 } coord } #AHM end code to allow for lty other than 1 #"Stretch" the arguments n<-length(x0) angle<-rep(angle,length=n)/360*2*pi length<-rep(length,length=n) width<-rep(width,length=n) col<-rep(col,length=n) border<-rep(border,length=n) lty<-rep(lty,length=n) arrowhead<-rep(arrowhead,length=n) offset.head<-rep(offset.head,length=n) offset.tail<-rep(offset.tail,length=n) curve<-rep(curve,length=n) edge.steps<-rep(edge.steps,length=n) #Obtain coordinates coord<-vector() for(i in 1:n) coord<-rbind(coord,make.coords(x0[i],y0[i],x1[i],y1[i],angle[i],length[i], width[i],offset.tail[i],offset.head[i],arrowhead[i],curve[i],edge.steps[i],lty[i])) coord<-coord[-NROW(coord),] #Draw polygons polygon(coord,col=col,border=border,...) #AHM no longer pass lty, taken care of internally. } #gplot.layout.adj - Layout method (MDS of inverted adjacency matrix) for gplot gplot.layout.adj<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="invadj" layout.par$dist="none" layout.par$exp=1 gplot.layout.mds(d,layout.par) } #gplot.layout.circle - Place vertices in a circular layout gplot.layout.circle<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") cbind(sin(2*pi*((0:(n-1))/n)),cos(2*pi*((0:(n-1))/n))) } #gplot.layout.circrand - Random circular layout for gplot gplot.layout.circrand<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$dist="uniang" gplot.layout.random(d,layout.par) } #gplot.layout.eigen - Place vertices based on the first two eigenvectors of #an adjacency matrix gplot.layout.eigen<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the matrix to be used if(is.null(layout.par$var)) vm<-d else vm<-switch(layout.par$var, symupper=symmetrize(d,rule="uppper"), symlower=symmetrize(d,rule="lower"), symstrong=symmetrize(d,rule="strong"), symweak=symmetrize(d,rule="weak"), user=layout.par$mat, raw=d ) #Pull the eigenstructure e<-eigen(vm) if(is.null(layout.par$evsel)) coord<-Re(e$vectors[,1:2]) else coord<-switch(layout.par$evsel, first=Re(e$vectors[,1:2]), size=Re(e$vectors[,rev(order(abs(e$values)))[1:2]]) ) #Return the result coord } #gplot.layout.fruchtermanreingold - Fruchterman-Reingold layout routine for #gplot gplot.layout.fruchtermanreingold<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] #Provide default settings n<-attr(d,"n") if(is.null(layout.par$niter)) niter<-500 else niter<-layout.par$niter if(is.null(layout.par$max.delta)) max.delta<-n else max.delta<-layout.par$max.delta if(is.null(layout.par$area)) area<-n^2 else area<-layout.par$area if(is.null(layout.par$cool.exp)) cool.exp<-3 else cool.exp<-layout.par$cool.exp if(is.null(layout.par$repulse.rad)) repulse.rad<-area*log(n) else repulse.rad<-layout.par$repulse.rad if(is.null(layout.par$ncell)) ncell<-ceiling(n^0.5) else ncell<-layout.par$ncell if(is.null(layout.par$cell.jitter)) cell.jitter<-0.5 else cell.jitter<-layout.par$cell.jitter if(is.null(layout.par$cell.pointpointrad)) cell.pointpointrad<-0 else cell.pointpointrad<-layout.par$cell.pointpointrad if(is.null(layout.par$cell.pointcellrad)) cell.pointcellrad<-18 else cell.pointcellrad<-layout.par$cell.pointcellrad if(is.null(layout.par$cellcellcellrad)) cell.cellcellrad<-ncell^2 else cell.cellcellrad<-layout.par$cell.cellcellrad if(is.null(layout.par$seed.coord)){ tempa<-sample((0:(n-1))/n) #Set initial positions randomly on the circle x<-n/(2*pi)*sin(2*pi*tempa) y<-n/(2*pi)*cos(2*pi*tempa) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Symmetrize the network, just in case d<-symmetrize(d,rule="weak",return.as.edgelist=TRUE) #Perform the layout calculation layout<-.C("gplot_layout_fruchtermanreingold_R", as.double(d), as.double(n), as.double(NROW(d)), as.integer(niter), as.double(max.delta), as.double(area), as.double(cool.exp), as.double(repulse.rad), as.integer(ncell), as.double(cell.jitter), as.double(cell.pointpointrad), as.double(cell.pointcellrad), as.double(cell.cellcellrad), x=as.double(x), y=as.double(y), PACKAGE="sna") #Return the result cbind(layout$x,layout$y) } #gplot.layout.geodist - Layout method (MDS of geodesic distances) for gplot gplot.layout.geodist<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="geodist" layout.par$dist="none" layout.par$exp=1 gplot.layout.mds(d,layout.par) } #gplot.layout.hall - Hall's layout method for gplot gplot.layout.hall<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] n<-NROW(d) #Build the Laplacian matrix sd<-symmetrize(d) laplacian<--sd diag(laplacian)<-degree(sd,cmode="indegree") #Return the eigenvectors with smallest eigenvalues eigen(laplacian)$vec[,(n-1):(n-2)] } #gplot.layout.kamadakawai gplot.layout.kamadakawai<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") if(is.null(layout.par$niter)){ niter<-1000 }else niter<-layout.par$niter if(is.null(layout.par$sigma)){ sigma<-n/4 }else sigma<-layout.par$sigma if(is.null(layout.par$initemp)){ initemp<-10 }else initemp<-layout.par$initemp if(is.null(layout.par$coolexp)){ coolexp<-0.99 }else coolexp<-layout.par$coolexp if(is.null(layout.par$kkconst)){ kkconst<-n^2 }else kkconst<-layout.par$kkconst if(is.null(layout.par$edge.val.as.str)) edge.val.as.str<-TRUE else edge.val.as.str<-layout.par$edge.val.as.str if(is.null(layout.par$elen)){ d<-symmetrize(d,return.as.edgelist=TRUE) if(edge.val.as.str) d[,3]<-1/d[,3] elen<-geodist(d,ignore.eval=FALSE)$gdist elen[elen==Inf]<-max(elen[is.finite(elen)])*1.25 }else elen<-layout.par$elen if(is.null(layout.par$seed.coord)){ x<-rnorm(n,0,n/4) y<-rnorm(n,0,n/4) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] } #Obtain locations pos<-.C("gplot_layout_kamadakawai_R",as.integer(n),as.integer(niter), as.double(elen),as.double(initemp),as.double(coolexp),as.double(kkconst),as.double(sigma), x=as.double(x),y=as.double(y), PACKAGE="sna") #Return to x,y coords cbind(pos$x,pos$y) } #gplot.layout.mds - Place vertices based on metric multidimensional scaling #of a distance matrix gplot.layout.mds<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the raw inputs for the scaling if(is.null(layout.par$var)) vm<-cbind(d,t(d)) else vm<-switch(layout.par$var, rowcol=cbind(d,t(d)), col=t(d), row=d, rcsum=d+t(d), rcdiff=t(d)-d, invadj=max(d)-d, geodist=geodist(d,inf.replace=NCOL(d))$gdist, user=layout.par$vm ) #If needed, construct the distance matrix if(is.null(layout.par$dist)) dm<-as.matrix(dist(vm)) else dm<-switch(layout.par$dist, euclidean=as.matrix(dist(vm)), maximum=as.matrix(dist(vm,method="maximum")), manhattan=as.matrix(dist(vm,method="manhattan")), canberra=as.matrix(dist(vm,method="canberra")), none=vm ) #Transform the distance matrix, if desired if(is.null(layout.par$exp)) dm<-dm^2 else dm<-dm^layout.par$exp #Perform the scaling and return cmdscale(dm,2) } #gplot.layout.princoord - Place using the eigenstructure of the correlation #matrix among concatenated rows/columns (principal coordinates by position #similarity) gplot.layout.princoord<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the vectors to be related if(is.null(layout.par$var)) vm<-rbind(d,t(d)) else vm<-switch(layout.par$var, rowcol=rbind(d,t(d)), col=d, row=t(d), rcsum=d+t(d), rcdiff=d-t(d), user=layout.par$vm ) #Find the correlation/covariance matrix if(is.null(layout.par$cor)||layout.par$cor) cd<-cor(vm,use="pairwise.complete.obs") else cd<-cov(vm,use="pairwise.complete.obs") cd<-replace(cd,is.na(cd),0) #Obtain the eigensolution e<-eigen(cd,symmetric=TRUE) x<-Re(e$vectors[,1]) y<-Re(e$vectors[,2]) cbind(x,y) } #gplot.layout.random - Random layout for gplot gplot.layout.random<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") #Determine the distribution if(is.null(layout.par$dist)) temp<-matrix(runif(2*n,-1,1),n,2) else if (layout.par$dist=="unif") temp<-matrix(runif(2*n,-1,1),n,2) else if (layout.par$dist=="uniang"){ tempd<-rnorm(n,1,0.25) tempa<-runif(n,0,2*pi) temp<-cbind(tempd*sin(tempa),tempd*cos(tempa)) }else if (layout.par$dist=="normal") temp<-matrix(rnorm(2*n),n,2) #Return the result temp } #gplot.layout.rmds - Layout method (MDS of euclidean row distances) for gplot gplot.layout.rmds<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="row" layout.par$dist="euclidean" layout.par$exp=1 gplot.layout.mds(d,layout.par) } #gplot.layout.segeo - Layout method (structural equivalence in geodesic #distances) for gplot gplot.layout.segeo<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="geodist" layout.par$dist="euclidean" gplot.layout.mds(d,layout.par) } #gplot.layout.seham - Layout method (structural equivalence under Hamming #metric) for gplot gplot.layout.seham<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="rowcol" layout.par$dist="manhattan" layout.par$exp=1 gplot.layout.mds(d,layout.par) } #gplot.layout.spring - Place vertices using a spring embedder gplot.layout.spring<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Set up the embedder params ep<-vector() if(is.null(layout.par$mass)) #Mass is in "quasi-kilograms" ep[1]<-0.1 else ep[1]<-layout.par$mass if(is.null(layout.par$equil)) #Equilibrium extension is in "quasi-meters" ep[2]<-1 else ep[2]<-layout.par$equil if(is.null(layout.par$k)) #Spring coefficient is in "quasi-Newtons/qm" ep[3]<-0.001 else ep[3]<-layout.par$k if(is.null(layout.par$repeqdis)) #Repulsion equilibrium is in qm ep[4]<-0.1 else ep[4]<-layout.par$repeqdis if(is.null(layout.par$kfr)) #Base coef of kinetic friction is in qn-qkg ep[5]<-0.01 else ep[5]<-layout.par$kfr if(is.null(layout.par$repulse)) repulse<-FALSE else repulse<-layout.par$repulse #Create initial condidions n<-dim(d)[1] f.x<-rep(0,n) #Set initial x/y forces to zero f.y<-rep(0,n) v.x<-rep(0,n) #Set initial x/y velocities to zero v.y<-rep(0,n) tempa<-sample((0:(n-1))/n) #Set initial positions randomly on the circle x<-n/(2*pi)*sin(2*pi*tempa) y<-n/(2*pi)*cos(2*pi*tempa) ds<-symmetrize(d,"weak") #Symmetrize/dichotomize the graph kfr<-ep[5] #Set initial friction level niter<-1 #Set the iteration counter #Simulate, with increasing friction, until motion stops repeat{ niter<-niter+1 #Update the iteration counter dis<-as.matrix(dist(cbind(x,y))) #Get inter-point distances #Get angles relative to the positive x direction theta<-acos(t(outer(x,x,"-"))/dis)*sign(t(outer(y,y,"-"))) #Compute spring forces; note that we assume a base spring coefficient #of ep[3] units ("pseudo-Newtons/quasi-meter"?), with an equilibrium #extension of ep[2] units for all springs f.x<-apply(ds*cos(theta)*ep[3]*(dis-ep[2]),1,sum,na.rm=TRUE) f.y<-apply(ds*sin(theta)*ep[3]*(dis-ep[2]),1,sum,na.rm=TRUE) #If node repulsion is active, add a force component for this #as well. We employ an inverse cube law which is equal in power #to the attractive spring force at distance ep[4] if(repulse){ f.x<-f.x-apply(cos(theta)*ep[3]/(dis/ep[4])^3,1,sum,na.rm=TRUE) f.y<-f.y-apply(sin(theta)*ep[3]/(dis/ep[4])^3,1,sum,na.rm=TRUE) } #Adjust the velocities (assume a mass of ep[1] units); note that the #motion is roughly modeled on the sliding of flat objects across #a uniform surface (e.g., spring-connected cylinders across a table). #We assume that the coefficients of static and kinetic friction are #the same, which should only trouble you if you are under the #delusion that this is a simulation rather than a graph drawing #exercise (in which case you should be upset that I'm not using #Runge-Kutta or the like!). v.x<-v.x+f.x/ep[1] #Add accumulated spring/repulsion forces v.y<-v.y+f.y/ep[1] spd<-sqrt(v.x^2+v.y^2) #Determine frictional forces fmag<-pmin(spd,kfr) #We can't let friction _create_ motion! theta<-acos(v.x/spd)*sign(v.y) #Calculate direction of motion f.x<-fmag*cos(theta) #Decompose frictional forces f.y<-fmag*sin(theta) f.x[is.nan(f.x)]<-0 #Correct for any 0/0 problems f.y[is.nan(f.y)]<-0 v.x<-v.x-f.x #Apply frictional forces (opposing motion - v.y<-v.y-f.y #note that mass falls out of equation) #Adjust the positions (yep, it's primitive linear updating time!) x<-x+v.x y<-y+v.y #Check for cessation of motion, and increase friction mdist<-mean(dis) if(all(v.xthresh,,drop=FALSE] attr(d,"n")<-n #Restore "n" to d #Determine coordinate placement if(!is.null(coord)){ #If the user has specified coords, override all other considerations x<-coord[,1] y<-coord[,2] z<-coord[,3] }else{ #Otherwise, use the specified layout function layout.fun<-try(match.fun(paste("gplot3d.layout.",mode,sep="")), silent=TRUE) if(inherits(layout.fun,"try-error")) stop("Error in gplot3d: no layout function for mode ",mode) temp<-layout.fun(d,layout.par) x<-temp[,1] y<-temp[,2] z<-temp[,3] } #Jitter the coordinates if need be if(jitter){ x<-jitter(x) y<-jitter(y) z<-jitter(z) } #Which nodes should we use? use<-displayisolates|(!is.isolate(d,ego=1:n)) #Deal with axis labels if(is.null(xlab)) xlab="" if(is.null(ylab)) ylab="" if(is.null(zlab)) zlab="" #Create the base plot, if needed if(new){ #If new==FALSE, we add to the existing plot; else create a new one rgl::clear3d() if(!suppress.axes) #Plot axes, if desired rgl::bbox3d(xlab=xlab,ylab=ylab,zlab=zlab); } rgl::bg3d(color=bg.col) #Plot vertices temp<-as.matrix(dist(cbind(x[use],y[use],z[use]))) diag(temp)<-Inf baserad<-min(temp)/5 if(is.null(vertex.radius)){ vertex.radius<-rep(baserad,n) }else if(absolute.radius) vertex.radius<-rep(vertex.radius,length=n) else vertex.radius<-rep(vertex.radius*baserad,length=n) vertex.col<-rep(vertex.col,length=n) vertex.alpha<-rep(vertex.alpha,length=n) if(!all(use==FALSE)) rgl::spheres3d(x[use],y[use],z[use],radius=vertex.radius[use], color=vertex.col[use], alpha=vertex.alpha[use]) #Generate the edges and their attributes pt<-vector() #Create position vectors (tail, head) ph<-vector() e.lwd<-vector() #Create edge attribute vectors e.col<-vector() e.alpha<-vector() e.diag<-vector() #Indicator for self-ties if(length(dim(edge.col))==2) #Coerce edge.col/edge.lty to vector form edge.col<-edge.col[d[,1:2]] else edge.col<-rep(edge.col,length=NROW(d)) if(is.null(edge.lwd)){ edge.lwd<-0.5*apply(cbind(vertex.radius[d[,1]],vertex.radius[d[,2]]),1, min) + vertex.radius[d[,1]]*(d[,1]==d[,2]) }else if(length(dim(edge.lwd))==2){ edge.lwd<-edge.lwd[d[,1:2]] }else{ if(edge.lwd==0) edge.lwd<-0.5*apply(cbind(vertex.radius[d[,1]],vertex.radius[d[,2]]),1, min) + vertex.radius[d[,1]]*(d[,1]==d[,2]) else edge.lwd<-rep(edge.lwd,length=NROW(d)) } if(length(dim(edge.alpha))==2){ edge.alpha<-edge.alpha[d[,1:2]] }else{ edge.alpha<-rep(edge.alpha,length=NROW(d)) } for(i in 1:NROW(d)) if(use[d[i,1]]&&use[d[i,2]]){ #Plot edges for displayed vertices pt<-rbind(pt,as.double(c(x[d[i,1]],y[d[i,1]],z[d[i,1]]))) #Store endpoint coordinates ph<-rbind(ph,as.double(c(x[d[i,2]],y[d[i,2]],z[d[i,2]]))) e.col<-c(e.col,edge.col[i]) #Store other edge attributes e.alpha<-c(e.alpha,edge.alpha[i]) e.lwd<-c(e.lwd,edge.lwd[i]) e.diag<-c(e.diag,d[i,1]==d[i,2]) #Is this a loop? } m<-NROW(pt) #Record number of edges #Plot loops for the diagonals, if diag==TRUE if(diag&&(m>0)&&sum(e.diag>0)){ #Are there any loops present? gplot3d.loop(pt[e.diag,],radius=e.lwd[e.diag],color=e.col[e.diag], alpha=e.alpha[e.diag]) } #Plot standard (i.e., non-loop) edges if(m>0){ #If edges are present, remove loops from consideration pt<-pt[!e.diag,] ph<-ph[!e.diag,] e.alpha<-e.alpha[!e.diag] e.lwd<-e.lwd[!e.diag] e.col<-e.col[!e.diag] } if(length(e.alpha)>0){ gplot3d.arrow(pt,ph,radius=e.lwd,color=e.col,alpha=e.alpha) } #Plot vertex labels, if needed if(displaylabels&(!all(label==""))&(!all(use==FALSE))){ rgl::texts3d(x[use]-vertex.radius[use],y[use],z[use],label[use], color=label.col) } #Return the vertex positions, should they be needed invisible(cbind(x,y,z)) } #gplot3d.arrow- Draw a three-dimensional "arrow" from the positions in a to #the positions in b, with specified characteristics. gplot3d.arrow<-function(a,b,radius,color="white",alpha=1){ #First, define an internal routine to make triangle coords make.coords<-function(a,b,radius){ alen<-sqrt(sum((a-b)^2)) xos<-radius*sin(pi/8) yos<-radius*cos(pi/8) basetri<-rbind( #Create single offset triangle, pointing +z c(-xos,-yos,0), c(0,0,alen), c(xos,-yos,0) ) coord<-vector() for(i in (1:8)/8*2*pi){ #Rotate about z axis to make arrow rmat<-rbind(c(cos(i),sin(i),0),c(-sin(i),cos(i),0), c(0,0,1)) coord<-rbind(coord,basetri%*%rmat) } #Rotate into final angle (spherical coord w/+z polar axis...I know...) phi<--atan2(b[2]-a[2],a[1]-b[1])-pi/2 psi<-acos((b[3]-a[3])/alen) coord<-coord%*%rbind(c(1,0,0),c(0,cos(psi),sin(psi)), c(0,-sin(psi),cos(psi))) coord<-coord%*%rbind(c(cos(phi),sin(phi),0),c(-sin(phi),cos(phi),0), c(0,0,1)) #Translate into position coord[,1]<-coord[,1]+a[1] coord[,2]<-coord[,2]+a[2] coord[,3]<-coord[,3]+a[3] #Return the matrix coord } #Expand argument vectors if needed if(is.null(dim(a))){ a<-matrix(a,ncol=3) b<-matrix(b,ncol=3) } n<-NROW(a) radius<-rep(radius,length=n) color<-rep(color,length=n) alpha<-rep(alpha,length=n) #Obtain the joint coordinate matrix coord<-vector() for(i in 1:n) coord<-rbind(coord,make.coords(a[i,],b[i,],radius[i])) #Draw the triangles rgl::triangles3d(coord[,1],coord[,2],coord[,3],color=rep(color,each=24), alpha=rep(alpha,each=24)) } #gplot3d.layout.adj - Layout method (MDS of inverse adjacencies) for gplot3d gplot3d.layout.adj<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="invadj" layout.par$dist="none" layout.par$exp=1 gplot3d.layout.mds(d,layout.par) } #gplot3d.layout.eigen - Place vertices based on the first three eigenvectors of #an adjacency matrix gplot3d.layout.eigen<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the matrix to be used if(is.null(layout.par$var)) vm<-d else vm<-switch(layout.par$var, symupper=symmetrize(d,rule="uppper"), symlower=symmetrize(d,rule="lower"), symstrong=symmetrize(d,rule="strong"), symweak=symmetrize(d,rule="weak"), user=layout.par$mat, raw=d ) #Pull the eigenstructure e<-eigen(vm) if(is.null(layout.par$evsel)) coord<-Re(e$vectors[,1:3]) else coord<-switch(layout.par$evsel, first=Re(e$vectors[,1:3]), size=Re(e$vectors[,rev(order(abs(e$values)))[1:3]]) ) #Return the result coord } #gplot3d.layout.fruchtermanreingold - Fruchterman-Reingold layout method for #gplot3d gplot3d.layout.fruchtermanreingold<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") #Provide default settings if(is.null(layout.par$niter)) niter<-300 else niter<-layout.par$niter if(is.null(layout.par$max.delta)) max.delta<-n else max.delta<-layout.par$max.delta if(is.null(layout.par$volume)) volume<-n^3 else volume<-layout.par$volume if(is.null(layout.par$cool.exp)) cool.exp<-3 else cool.exp<-layout.par$cool.exp if(is.null(layout.par$repulse.rad)) repulse.rad<-volume*n else repulse.rad<-layout.par$repulse.rad if(is.null(layout.par$seed.coord)){ tempa<-runif(n,0,2*pi) #Set initial positions randomly on the sphere tempb<-runif(n,0,pi) x<-n*sin(tempb)*cos(tempa) y<-n*sin(tempb)*sin(tempa) z<-n*cos(tempb) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] z<-layout.par$seed.coord[,3] } #Symmetrize the graph, just in case d<-symmetrize(d,return.as.edgelist=TRUE) #Set up positions #Perform the layout calculation layout<-.C("gplot3d_layout_fruchtermanreingold_R", as.double(d), as.integer(n), as.integer(NROW(d)), as.integer(niter), as.double(max.delta), as.double(volume), as.double(cool.exp), as.double(repulse.rad), x=as.double(x), y=as.double(y), z=as.double(z),PACKAGE="sna") #Return the result cbind(layout$x,layout$y,layout$z) } #gplot3d.layout.geodist - Layout method (MDS of geodesic distances) for gplot3d gplot3d.layout.geodist<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="geodist" layout.par$dist="none" layout.par$exp=1 gplot3d.layout.mds(d,layout.par) } #gplot3d.layout.hall - Hall's layout method for gplot3d gplot3d.layout.hall<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] n<-NCOL(d) #Build the Laplacian matrix sd<-symmetrize(d) laplacian<--sd diag(laplacian)<-degree(sd,cmode="indegree") #Return the eigenvectors with smallest eigenvalues eigen(laplacian)$vec[,(n-1):(n-3)] } #gplot3d.layout.kamadakawai gplot3d.layout.kamadakawai<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") if(is.null(layout.par$niter)){ niter<-1000 }else niter<-layout.par$niter if(is.null(layout.par$sigma)){ sigma<-n/4 }else sigma<-layout.par$sigma if(is.null(layout.par$initemp)){ initemp<-10 }else initemp<-layout.par$initemp if(is.null(layout.par$coolexp)){ coolexp<-0.99 }else coolexp<-layout.par$coolexp if(is.null(layout.par$kkconst)){ kkconst<-n^3 }else kkconst<-layout.par$kkconst if(is.null(layout.par$edge.val.as.str)) edge.val.as.str<-TRUE else edge.val.as.str<-layout.par$edge.val.as.str if(is.null(layout.par$elen)){ d<-symmetrize(d,return.as.edgelist=TRUE) if(edge.val.as.str) d[,3]<-1/d[,3] elen<-geodist(d,ignore.eval=FALSE)$gdist elen[elen==Inf]<-max(elen[is.finite(elen)])*1.5 }else elen<-layout.par$elen if(is.null(layout.par$seed.coord)){ x<-rnorm(n,0,n/4) y<-rnorm(n,0,n/4) z<-rnorm(n,0,n/4) }else{ x<-layout.par$seed.coord[,1] y<-layout.par$seed.coord[,2] z<-layout.par$seed.coord[,3] } #Obtain locations pos<-.C("gplot3d_layout_kamadakawai_R",as.double(n), as.integer(niter),as.double(elen),as.double(initemp),as.double(coolexp), as.double(kkconst),as.double(sigma),x=as.double(x),y=as.double(y), z=as.double(z),PACKAGE="sna") #Return to x,y coords cbind(pos$x,pos$y,pos$z) } #gplot3d.layout.mds - Place vertices based on metric multidimensional scaling #of a distance matrix gplot3d.layout.mds<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the raw inputs for the scaling if(is.null(layout.par$var)) vm<-cbind(d,t(d)) else vm<-switch(layout.par$var, rowcol=cbind(d,t(d)), col=t(d), row=d, rcsum=d+t(d), rcdiff=t(d)-d, invadj=max(d)-d, geodist=geodist(d,inf.replace=NROW(d))$gdist, user=layout.par$vm ) #If needed, construct the distance matrix if(is.null(layout.par$dist)) dm<-as.matrix(dist(vm)) else dm<-switch(layout.par$dist, euclidean=as.matrix(dist(vm)), maximum=as.matrix(dist(vm,method="maximum")), manhattan=as.matrix(dist(vm,method="manhattan")), canberra=as.matrix(dist(vm,method="canberra")), none=vm ) #Transform the distance matrix, if desired if(is.null(layout.par$exp)) dm<-dm^2 else dm<-dm^layout.par$exp #Perform the scaling and return cmdscale(dm,3) } #gplot3d.layout.princoord - Place using the eigenstructure of the correlation #matrix among concatenated rows/columns (principal coordinates by position #similarity) gplot3d.layout.princoord<-function(d,layout.par){ d<-as.sociomatrix.sna(d) if(is.list(d)) d<-d[[1]] #Determine the vectors to be related if(is.null(layout.par$var)) vm<-rbind(d,t(d)) else vm<-switch(layout.par$var, rowcol=rbind(d,t(d)), col=d, row=t(d), rcsum=d+t(d), rcdiff=d-t(d), user=layout.par$vm ) #Find the correlation/covariance matrix if(is.null(layout.par$cor)||layout.par$cor) cd<-cor(vm,use="pairwise.complete.obs") else cd<-cov(vm,use="pairwise.complete.obs") cd<-replace(cd,is.na(cd),0) #Obtain the eigensolution e<-eigen(cd,symmetric=TRUE) x<-Re(e$vectors[,1]) y<-Re(e$vectors[,2]) z<-Re(e$vectors[,3]) cbind(x,y,z) } #gplot3d.layout.random - Layout method (random placement) for gplot3d gplot3d.layout.random<-function(d,layout.par){ d<-as.edgelist.sna(d) if(is.list(d)) d<-d[[1]] n<-attr(d,"n") #Determine the distribution if(is.null(layout.par$dist)) temp<-matrix(runif(3*n,-1,1),n,3) else if (layout.par$dist=="unif") temp<-matrix(runif(3*n,-1,1),n,3) else if (layout.par$dist=="uniang"){ tempd<-rnorm(n,1,0.25) tempa<-runif(n,0,2*pi) tempb<-runif(n,0,pi) temp<-cbind(tempd*sin(tempb)*cos(tempa),tempd*sin(tempb)*sin(tempa), tempd*cos(tempb)) }else if (layout.par$dist=="normal") temp<-matrix(rnorm(3*n),n,3) #Return the result temp } #gplot3d.layout.rmds - Layout method (MDS of euclidean row distances) for #gplot3d gplot3d.layout.rmds<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="row" layout.par$dist="euclidean" layout.par$exp=1 gplot3d.layout.mds(d,layout.par) } #gplot3d.layout.segeo - Layout method (structural equivalence on geodesic #distances) for gplot3d gplot3d.layout.segeo<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="geodist" layout.par$dist="euclidean" gplot3d.layout.mds(d,layout.par) } #gplot3d.layout.seham - Layout method (structural equivalence under Hamming #metric) for gplot3d gplot3d.layout.seham<-function(d,layout.par){ if(is.null(layout.par)) layout.par<-list() layout.par$var="rowcol" layout.par$dist="manhattan" layout.par$exp=1 gplot3d.layout.mds(d,layout.par) } #gplot3d.loop - Draw a three-dimensional "loop" at position a, with specified #characteristics. gplot3d.loop<-function(a,radius,color="white",alpha=1){ #First, define an internal routine to make triangle coords make.coords<-function(a,radius){ coord<-rbind( cbind( a[1]+c(0,-radius/2,0), a[2]+c(0,radius/2,radius/2), a[3]+c(0,0,radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,-radius/2,0), a[2]+c(0,radius/2,radius/2), a[3]+c(0,0,-radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,radius/2,0), a[2]+c(0,radius/2,radius/2), a[3]+c(0,0,radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,radius/2,0), a[2]+c(0,radius/2,radius/2), a[3]+c(0,0,-radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,-radius/2,0), a[2]+c(radius,radius/2,radius/2), a[3]+c(0,0,radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,-radius/2,0), a[2]+c(radius,radius/2,radius/2), a[3]+c(0,0,-radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,radius/2,0), a[2]+c(radius,radius/2,radius/2), a[3]+c(0,0,radius/4), c(NA,NA,NA) ), cbind( a[1]+c(0,radius/2,0), a[2]+c(radius,radius/2,radius/2), a[3]+c(0,0,-radius/4), c(NA,NA,NA) ) ) } #Expand argument vectors if needed if(is.null(dim(a))){ a<-matrix(a,ncol=3) } n<-NROW(a) radius<-rep(radius,length=n) color<-rep(color,length=n) alpha<-rep(alpha,length=n) #Obtain the joint coordinate matrix coord<-vector() for(i in 1:n) coord<-rbind(coord,make.coords(a[i,],radius[i])) #Plot the triangles rgl::triangles3d(coord[,1],coord[,2],coord[,3],color=rep(color,each=24), alpha=rep(alpha,each=24)) } #plot.sociomatrix - An odd sort of plotting routine; plots a matrix (e.g., a #Bernoulli graph density, or a set of adjacencies) as an image. Very handy for #visualizing large valued matrices... plot.sociomatrix<-function(x, labels=NULL, drawlab=TRUE, diaglab=TRUE, drawlines=TRUE, xlab=NULL, ylab=NULL, cex.lab=1, font.lab=1, col.lab=1, scale.values=TRUE, cell.col=gray, ...){ #Begin preprocessing if((!inherits(x,c("matrix","array","data.frame")))||(length(dim(x))>2)) x<-as.sociomatrix.sna(x) if(is.list(x)) x<-x[[1]] #End preprocessing n<-dim(x)[1] o<-dim(x)[2] if(is.null(labels)) labels<-list(NULL,NULL) if(is.null(labels[[1]])){ #Set labels, if needed if(is.null(rownames(x))) labels[[1]]<-1:dim(x)[1] else labels[[1]]<-rownames(x) } if(is.null(labels[[2]])){ if(is.null(colnames(x))) labels[[2]]<-1:dim(x)[2] else labels[[2]]<-colnames(x) } if(scale.values) d<-1-(x-min(x,na.rm=TRUE))/(max(x,na.rm=TRUE)-min(x,na.rm=TRUE)) else d<-x if(is.null(xlab)) xlab<-"" if(is.null(ylab)) ylab<-"" plot(1,1,xlim=c(0,o+1),ylim=c(n+1,0),type="n",axes=FALSE,xlab=xlab,ylab=ylab, ...) for(i in 1:n) for(j in 1:o) rect(j-0.5,i+0.5,j+0.5,i-0.5,col=cell.col(d[i,j]),xpd=TRUE, border=drawlines) rect(0.5,0.5,o+0.5,n+0.5,col=NA,xpd=TRUE) if(drawlab){ text(rep(0,n),1:n,labels[[1]],cex=cex.lab,font=font.lab,col=col.lab) text(1:o,rep(0,o),labels[[2]],cex=cex.lab,font=font.lab,col=col.lab) } if((n==o)&(drawlab)&(diaglab)) if(all(labels[[1]]==labels[[2]])) text(1:o,1:n,labels[[1]],cex=cex.lab,font=font.lab,col=col.lab) } #sociomatrixplot - an alias for plot.sociomatrix sociomatrixplot<-plot.sociomatrix sna/R/roles.R0000644000176200001440000004373214533477465012536 0ustar liggesusers###################################################################### # # roles.R # # copyright (c) 2004, Carter T. Butts # Last Modified 1/28/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains functions relating to role analysis. # # Contents: # blockmodel # blockmodel.expand # equiv.clust # plot.blockmodel # plot.equiv.clust # print.blockmodel # print.equiv.clust # print.summary.blockmodel # redist # sedist # summary.blockmodel # ###################################################################### #blockmodel - Generate blockmodels based on partitions of network positions blockmodel<-function(dat,ec,k=NULL,h=NULL,block.content="density",plabels=NULL,glabels=NULL,rlabels=NULL,mode="digraph",diag=FALSE){ #First, extract the blocks if(inherits(ec,"equiv.clust")) b<-cutree(ec$cluster,k,h) else if(inherits(ec,"hclust")) b<-cutree(ec,k,h) else b<-ec #Prepare the data dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("Blockmodel requires input graphs to be of identical order.") n<-dim(dat)[2] if(length(dim(dat))>2) d<-dat else{ d<-array(dim=c(1,n,n)) d[1,,]<-dat } if(!diag) d<-diag.remove(d) #Get labels if(is.null(plabels)){ if(inherits(ec,"equiv.clust")) plabels<-ec$plabels else plabels<-1:length(b) } if(is.null(glabels)){ if(inherits(ec,"equiv.clust")) glabels<-ec$glabels else glabels<-1:length(b) } #Now, construct a model rn<-max(b) rm<-dim(d)[1] if(is.null(rlabels)) #Add labels for roles if needed rlabels<-paste("Block",1:rn) bm<-array(dim=c(rm,rn,rn)) for(i in 1:rm) for(j in 1:rn) for(k in 1:rn){ if(block.content=="density") bm[i,j,k]<-mean(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) else if(block.content=="meanrowsum"){ bm[i,j,k]<-mean(apply(d[i,b==j,b==k,drop=FALSE],2,sum,na.rm=TRUE)) }else if(block.content=="meancolsum"){ bm[i,j,k]<-mean(apply(d[i,b==j,b==k,drop=FALSE],3,sum,na.rm=TRUE)) }else if(block.content=="sum"){ bm[i,j,k]<-sum(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) }else if(block.content=="median"){ bm[i,j,k]<-median(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) }else if(block.content=="min"){ bm[i,j,k]<-min(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) }else if(block.content=="max"){ bm[i,j,k]<-max(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) }else if(block.content=="types"){ temp<-mean(d[i,b==j,b==k,drop=FALSE],na.rm=TRUE) if(is.nan(temp)) #Is this a nan block (due to having only one actor)? bm[i,j,k]<-"NA" else if(temp==0) #Is this a null block? bm[i,j,k]<-"null" else if(temp==1) #How about a complete block? bm[i,j,k]<-"complete" else if(all(apply(d[i,b==j,b==k,drop=FALSE],2,sum,na.rm=TRUE)>0,apply(d[i,b==j,b==k,drop=FALSE],3,sum,na.rm=TRUE)>0)) bm[i,j,k]<-"1 covered" #1 covered block else if(all(apply(d[i,b==j,b==k,drop=FALSE],2,sum,na.rm=TRUE)>0)) bm[i,j,k]<-"1 row-covered" #1 row-covered block else if(all(apply(d[i,b==j,b==k,drop=FALSE],3,sum,na.rm=TRUE)>0)) bm[i,j,k]<-"1 col-covered" #1 col-covered block else bm[i,j,k]<-"other" #other block } } #Prepare the output object if(inherits(ec,"equiv.clust")) pord<-ec$cluster$order else if(inherits(ec,"hclust")) pord<-ec$order else pord<-order(ec) o<-list() o$block.membership<-b[pord] o$order.vector<-pord o$block.content<-block.content if(length(dim(dat))>2){ o$blocked.data<-dat[,pord,pord] dimnames(o$blocked.data)<-list(glabels,plabels[pord],plabels[pord]) }else{ o$blocked.data<-dat[pord,pord] dimnames(o$blocked.data)<-list(plabels[pord],plabels[pord]) } if(dim(bm)[1]==1){ o$block.model<-bm[1,,] rownames(o$block.model)<-rlabels colnames(o$block.model)<-rlabels }else{ o$block.model<-bm dimnames(o$block.model)<-list(glabels,rlabels,rlabels) } o$plabels<-plabels[pord] o$glabels<-glabels o$rlabels<-rlabels o$cluster.method<-switch(class(ec)[1], equiv.clust=ec$cluster.method, hclust=ec$method, "Prespecified" ) o$equiv.fun<-switch(class(ec)[1], equiv.clust=ec$equiv.fun, "None" ) o$equiv.metric<-switch(class(ec)[1], equiv.clust=ec$metric, "None" ) class(o)<-"blockmodel" o } #blockmodel.expand - Generate a graph (or stack) from a given blockmodel using #particular expansion rules blockmodel.expand<-function(b,ev,mode="digraph",diag=FALSE){ #First, get some useful parameters and such en<-sum(ev) el<-length(ev) bn<-max(b$block.membership) bm<-stackcount(b$block.model) if(bm>1) block.model<-b$block.model else{ block.model<-array(dim=c(1,bn,bn)) block.model[1,,]<-b$block.model } #Now, perform the expansion) expanded<-array(dim=c(bm,en,en)) for(i in 1:bm){ if(b$block.content=="density"){ tp<-matrix(nrow=en,ncol=en) for(j in 1:el) for(k in 1:el) tp[(cumsum(ev)[j]-ev[j]+1):(cumsum(ev)[j]),(cumsum(ev)[k]-ev[k]+1):(cumsum(ev)[k])]<-block.model[i,j,k] tp[is.na(tp)|is.nan(tp)]<-0 #Fill in any NA or NaN blocks with zero expanded[i,,]<-rgraph(en,1,tprob=tp,mode=mode,diag=diag) }else stop(paste("\nContent type",b$block.content,"not supported yet.\n")) } #Return the output data if(dim(expanded)[1]>1) expanded else expanded[1,,] } #equiv.clust - Find clusters of positions based on an equivalence relation equiv.clust<-function(dat,g=NULL,equiv.dist=NULL,equiv.fun="sedist",method="hamming",mode="digraph",diag=FALSE,cluster.method="complete",glabels=NULL,plabels=NULL,...){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) #End pre-processing #First, find the equivalence distances using the appropriate function and method if(is.null(g)){ #Set g to all graphs, if needed if(is.list(dat)) g<-1:length(dat) else if(is.array(dat)) g<-1:dim(dat)[1] else g<-1 } if(is.null(equiv.dist)){ equiv.dist.fun<-match.fun(equiv.fun) equiv.dist<-equiv.dist.fun(dat,g=g,method=method,joint.analysis=TRUE, mode=mode,diag=diag,code.diss=TRUE,...) } #Generate the output object o<-list() #Produce the hierarchical clustering o$cluster<-hclust(as.dist(equiv.dist),method=cluster.method) #Generate labels if(is.null(glabels)){ if(is.list(dat)) glabels<-names(dat)[g] else glabels<-dimnames(dat)[[1]][g] } if(is.null(plabels)){ if(is.list(dat)) plabels<-dimnames(dat[[g]])[[2]] else plabels<-dimnames(dat)[[2]] } #Set the output class and take care of other details o$metric<-method o$equiv.fun<-equiv.fun o$cluster.method<-cluster.method if((length(dim(dat))==1)&(length(glabels)>1)) o$glabels<-glabels[1] else o$glabels<-glabels o$plabels<-plabels class(o)<-"equiv.clust" #Produce the output o } #plot.blockmodel - Plotting for blockmodel objects plot.blockmodel<-function(x,...){ #Save old settings oldpar<-par(no.readonly=TRUE) on.exit(par(oldpar)) #Get new settings from data n<-dim(x$blocked.data)[2] m<-stackcount(x$blocked.data) if(!is.null(x$plabels)) plab<-x$plabels else plab<-(1:n)[x$order.vector] if(!is.null(x$glabels)) glab<-x$glabels else glab<-1:m #Now, plot the blocked data par(mfrow=c(floor(sqrt(m)),ceiling(m/floor(sqrt(m))))) if(m>1) for(i in 1:m){ plot.sociomatrix(x$blocked.data[i,,],labels=list(plab,plab), main=paste("Relation - ",glab[i]),drawlines=FALSE) for(j in 2:n) if(x$block.membership[j]!=x$block.membership[j-1]) abline(v=j-0.5,h=j-0.5,lty=3) } else{ plot.sociomatrix(x$blocked.data,labels=list(plab,plab), main=paste("Relation - ",glab[1]),drawlines=FALSE) for(j in 2:n) if(x$block.membership[j]!=x$block.membership[j-1]) abline(v=j-0.5,h=j-0.5,lty=3) } } #plot.equiv.clust - Plotting for equivalence clustering objects plot.equiv.clust<-function(x,labels=NULL,...){ if(is.null(labels)) plot(x$cluster,labales=x$labels,...) else plot(x$cluster,labels=labels,...) } #print.blockmodel - Printing for blockmodel objects print.blockmodel<-function(x,...){ cat("\nNetwork Blockmodel:\n\n") cat("Block membership:\n\n") if(is.null(x$plabels)) #Get position labels plab<-(1:length(x$block.membership))[x$order.vector] else plab<-x$plabels temp<-matrix(x$block.membership,nrow=1) dimnames(temp)<-list("",plab) print(temp[1,order(x$order.vector)]) #Print in original order cat("\nReduced form blockmodel:\n\n") if(length(dim(x$block.model))>2){ for(i in 1:dim(x$block.model)[1]){ temp<-x$block.model[i,,] dimnames(temp)<-list(x$rlabels,x$rlabels) cat("\t",x$glabels[i],"\n") print(temp) cat("\n") } }else{ temp<-x$block.model dimnames(temp)<-list(x$rlabels,x$rlabels) cat("\t",x$glabels,"\n") print(temp) } } #print.equiv.clust - Printing for equiv.clust objects print.equiv.clust<-function(x, ...){ cat("Position Clustering:\n\n") cat("\tEquivalence function:",x$equiv.fun,"\n") cat("\tEquivalence metric:",x$metric,"\n") cat("\tCluster method:",x$cluster.method,"\n") cat("\tGraph order:",length(x$cluster$order),"\n\n") } #print.summary.blockmodel - Printing for blockmodel summary objects print.summary.blockmodel<-function(x,...){ cat("\nNetwork Blockmodel:\n\n") cat("\nGeneral information:\n\n") cat("\tEquivalence function: ",x$equiv.fun,"\n") cat("\tEquivalence metric: ",x$equiv.metric,"\n") cat("\tClustering method: ",x$cluster.method,"\n") cat("\tBlockmodel content: ",x$block.content,"\n") cat("\n\nBlock membership by actor:\n\n") if(is.null(x$plabels)) #Get position labels plab<-(1:length(x$block.membership))[x$order.vector] else plab<-x$plabels temp<-matrix(x$block.membership,nrow=1) dimnames(temp)<-list("",plab) print(temp[1,order(x$order.vector)]) #Print in original order cat("\n\nBlock membership by block:\n\n") for(i in 1:max(x$block.membership)) cat("\t",x$rlabels[i],":",plab[x$block.membership==i],"\n") cat("\n\nReduced form blockmodel:\n\n") if(length(dim(x$block.model))>2){ for(i in 1:dim(x$block.model)[1]){ temp<-x$block.model[i,,] dimnames(temp)<-list(x$rlabels,x$rlabels) cat("\t",x$glabels[i],"\n") print(temp) cat("\n") } }else{ temp<-x$block.model dimnames(temp)<-list(x$rlabels,x$rlabels) cat("\t",x$glabels,"\n") print(temp) } cat("\n\nBlocked data:\n\n") if(length(dim(x$block.model))>2){ for(i in 1:dim(x$block.model)[1]){ temp<-x$blocked.data[i,,] dimnames(temp)<-list(plab,plab) cat("\t",x$glabels[i],"\n") print(temp) cat("\n") } }else{ temp<-x$blocked.data dimnames(temp)<-list(plab,plab) cat("\t",x$glabels,"\n") print(temp) } } #redist - Find a matrix of distances between positions based on regular #equivalence redist<-function(dat, g=NULL, method=c("catrege"), mode="digraph", diag=FALSE, seed.partition=NULL, code.diss=TRUE, ...){ #Internal function to compute neighborhoods for CATREGE neighb<-function(){ nmat<-array(0,dim=c(r,n,n)) for(i in 1:n) for(j in 1:n) if(d[i,j]>0) nmat[d[i,j],i,part1[j]]<-TRUE nmat } #Prep the data dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("redist requires input graphs to be of identical order.") if(is.null(g)) g<-1:dim(dat)[1] if(length(dim(dat)) > 2) { n <- dim(dat)[2] m <- length(g) d <- dat[g, , ] }else{ n <- dim(dat)[2] m <- 1 d <- array(dim = c(m, n, n)) d[1, , ] <- dat } if(mode == "graph") d <- symmetrize(d) if(m==1) d<-array(d,dim=c(1,n,n)) if (!diag) d <- diag.remove(d,0) #Currently, treat as zeros #Build the categorical matrix da<-array(dim=c(2*m,n,n)) #First, perform symmetric interleaving for(i in 1:m){ da[i*2-1,,]<-d[i,,] da[i*2,,]<-t(d[i,,]) } d<-apply(da,c(2,3),paste,collapse=" ") #Convert to strings vals<-apply(sapply((1:2^(2*m))-1,function(z){(z%/%2^((1:(2*m))-1))%%2}),2, paste,collapse=" ") #Obtain all possible strings r<-length(vals)-1 #Non-null values d<-apply(d,c(1,2),match,vals)-1 #Replace with numeric values # print(d[1:15,1:15]) # vals<-sort(unique(as.vector(d))) #Obtain unique values # print(vals) # r<-length(vals-1) #Get number of unique values # vals0<-grep("NA",vals) #Fix zeros # print(vals0) # vals0<-c(vals0,((1:r)[-vals0])[as.numeric(gsub(" ","",vals[-vals0]))==0]) # print(vals0) # d<-apply(d,c(1,2),match,vals) #Replace vals with numerics # d[d%in%vals0]<-0 #Set zeros #Compute the equivalence if(match.arg(method)=="catrege"){ outpart<-vector() if(is.null(seed.partition)) part1<-rep(1,n) #Create initial partition memberships else part1<-seed.partition flag<-TRUE while(flag){ nmat<-neighb() #Compute neighborhoods, using current partition outpart<-rbind(outpart,part1) flag<-FALSE #Set change flag part2<-1:n for(i in 2:n) for(j in 1:(i-1)) if(part1[i]==part1[j]){ if(all(nmat[,i,]==nmat[,j,])) part2[i]<-part2[j] else flag<-TRUE } part1<-part2 } imax<-function(i,j){ #Get the maximum iteration in which i and j were together (or 0 if never) if(any(outpart[,i]==outpart[,j])) max((1:NROW(outpart))[outpart[,i]==outpart[,j]]) else 0 } eq<-matrix(0,n,n) for(i in 1:n) for(j in 1:n) eq[i,j]<-imax(i,j) } #Transform and rescale to distance form if required if(!code.diss) eq else{ if(max(eq)==min(eq)) matrix(0,NROW(eq),NCOL(eq)) else (max(eq)-eq)/(max(eq)-min(eq)) } } #sedist - Find a matrix of distances between positions based on structural #equivalence sedist<-function(dat,g=c(1:dim(dat)[1]),method="hamming",joint.analysis=FALSE,mode="digraph",diag=FALSE,code.diss=FALSE){ #First, prepare the data dat<-as.sociomatrix.sna(dat,simplify=TRUE) if(is.list(dat)) stop("sedist requires input graphs to be of identical order.") if(length(dim(dat))>2){ n<-dim(dat)[2] m<-length(g) d<-dat[g,,,drop=FALSE] }else{ n<-dim(dat)[2] m<-1 d<-array(dim=c(m,n,n)) d[1,,]<-dat } if(!diag) d<-diag.remove(d) #Are we conducting a joint analysis? if(joint.analysis){ o<-array(dim=c(1,n,n)) #Build the data matrix v<-vector() for(i in 1:n) v<-cbind(v,c(as.vector(d[,i,]),as.vector(d[,,i]))) #Proceed by method if(method=="correlation"){ o[1,,]<-cor(v,use="pairwise") #Reverse code? if(code.diss) o<--o }else if(method=="euclidean"){ for(i in 1:n) for(j in 1:n) o[1,i,j]<-sqrt(sum((v[,i]-v[,j])^2,na.rm=TRUE)) }else if(method=="hamming"){ for(i in 1:n) for(j in 1:n) o[1,i,j]<-sum(abs(v[,i]-v[,j]),na.rm=TRUE) }else if(method=="gamma"){ for(i in 1:n) for(j in 1:n){ concord<-sum(as.numeric(v[,i]==v[,j]),na.rm=TRUE) discord<-sum(as.numeric(v[,i]!=v[,j]),na.rm=TRUE) o[1,i,j]<-(concord-discord)/(concord+discord) } #Reverse code? if(code.diss) o<--o }else if(method=="exact"){ for(i in 1:n) for(j in 1:n) o[1,i,j]<-as.numeric(any(v[!(is.na(v[,i])|is.na(v[,j])),i]!=v[!(is.na(v[,i])|is.na(v[,j])),j])) } }else{ #Analyze each graph seperately o<-array(dim=c(m,n,n)) for(k in 1:m){ #Build the data matrix v<-vector() for(i in 1:n) v<-cbind(v,c(as.vector(d[k,i,]),as.vector(d[k,,i]))) #Proceed by method if(method=="correlation"){ o[k,,]<-cor(v,use="pairwise") o[k,,][is.na(o[k,,])]<-0 #Reverse code? if(code.diss) o[k,,]<--o[k,,] }else if(method=="euclidean"){ for(i in 1:n) for(j in 1:n) o[k,i,j]<-sqrt(sum((v[,i]-v[,j])^2,na.rm=TRUE)) }else if(method=="hamming"){ for(i in 1:n) for(j in 1:n) o[k,i,j]<-sum(abs(v[,i]-v[,j]),na.rm=TRUE) }else if(method=="gamma"){ for(i in 1:n) for(j in 1:n){ concord<-sum(as.numeric(v[,i]==v[,j]),na.rm=TRUE) discord<-sum(as.numeric(v[,i]!=v[,j]),na.rm=TRUE) o[k,i,j]<-(concord-discord)/(concord+discord) } #Reverse code? if(code.diss) o[k,,]<--o[k,,] }else if(method=="exact"){ for(i in 1:n) for(j in 1:n) o[k,i,j]<-as.numeric(any(v[!(is.na(v[,i])|is.na(v[,j])),i]!=v[!(is.na(v[,i])|is.na(v[,j])),j])) } } } #Dump the output if(dim(o)[1]==1) as.matrix(o[1,,]) else o } #summary.blockmodel - Detailed printing for blockmodel objects summary.blockmodel<-function(object, ...){ o<-object class(o)<-"summary.blockmodel" o } sna/R/connectivity.R0000644000176200001440000006301714533477562014124 0ustar liggesusers###################################################################### # # connectivity.R # # copyright (c) 2004, Carter T. Butts # Last Modified 8/14/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains various routines associated with connectivity # properties (including geodesic distance and friends). # # Contents: # bicomponent.dist # clique.census # component.dist # component.largest # component.size.byvertex # components # cutpoints # geodist # isolates # is.connected # is.isolate # kcores # kcycle.census # kpath.census # maxflow # neighborhood # reachability # simmelian # structure.statistics # ###################################################################### #bicomponent.dist - Returns a list containing a vector of length n such that #the ith element contains the number of components of G having size i, and a #vector of length n giving component membership. Component strength is #determined by the rule which is used to symmetrize the matrix; this controlled #by the eponymous parameter given to the symmetrize command. bicomponent.dist<-function(dat,symmetrize=c("strong","weak")){ #Pre-process the raw input dat<-as.edgelist.sna(dat,suppress.diag=TRUE) if(is.list(dat)) return(lapply(dat,bicomponent.dist,symmetrize=symmetrize)) #End pre-processing #Begin routine n<-attr(dat,"n") #Symmetrize dat based on the connectedness rule dat<-symmetrize(dat,rule=match.arg(symmetrize),return.as.edgelist=TRUE) #Compute the bicomponents bc<-.Call("bicomponents_R",dat,n,NROW(dat),PACKAGE="sna") if(length(bc[[1]])>1){ #Sort by size ord<-order(sapply(bc[[1]],length),decreasing=TRUE) bc[[1]]<-bc[[1]][ord] bc[[2]][bc[[2]]>0]<-match(bc[[2]][bc[[2]]>0],ord) } bc[[2]][bc[[2]]<0]<-NA bc[[1]]<-bc[[1]][sapply(bc[[1]],length)>0] #Return the results o<-list() if(length(bc[[1]])>0){ o$members<-bc[[1]] #Copy membership lists names(o$members)<-1:length(o$members) o$membership<-bc[[2]] #Copy memberships o$csize<-sapply(o$members,length) #Extract component sizes names(o$csize)<-1:length(o$csize) o$cdist<-tabulate(o$csize,nbins=n) #Find component size distribution names(o$cdist)<-1:n }else{ o$members<-list() o$membership<-bc[[2]] o$csize<-vector(mode="numeric") o$cdist<-rep(0,n) names(o$cdist)<-1:n } o } #clique.census - Enumerate all maximal cliques clique.census<-function(dat,mode="digraph",tabulate.by.vertex=TRUE,clique.comembership=c("none","sum","bysize"),enumerate=TRUE, na.omit=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,clique.census,mode=mode, tabulate.by.vertex=tabulate.by.vertex,clique.comembership=clique.comembership,enumerate=enumerate, na.omit=na.omit)) #End pre-processing n<-attr(dat,"n") if(is.null(attr(dat,"vnames"))) vnam<-paste("v",1:n,sep="") else vnam<-attr(dat,"vnames") if(na.omit) dat<-dat[!is.na(dat[,3]),,drop=FALSE] #Drop any edges with NAs else dat[is.na(dat[,3]),3]<-1 #Else, recode to safe values dat<-dat[dat[,1]!=dat[,2],] #Remove loops attr(dat,"n")<-n #If called with a digraph, symmetrize if(mode=="digraph") dat<-symmetrize(dat,rule="strong",return.as.edgelist=TRUE) #Compute the census clique.comembership<-switch(match.arg(clique.comembership), none=0, sum=1, bysize=2 ) census<-.Call("cliques_R",dat,n,NROW(dat),tabulate.by.vertex, clique.comembership,enumerate,PACKAGE="sna") #Assemble the results maxsize<-census[[1]] census<-census[-1] names(census)<-c("clique.count","clique.comemb","cliques") if(tabulate.by.vertex){ census[[1]]<-matrix(census[[1]],maxsize,n+1) census[[1]]<-census[[1]][,c(n+1,1:n),drop=FALSE] rownames(census[[1]])<-1:maxsize colnames(census[[1]])<-c("Agg",vnam) }else{ names(census[[1]])<-1:length(census[[1]]) } if(clique.comembership==1){ census[[2]]<-matrix(census[[2]],n,n) rownames(census[[2]])<-vnam colnames(census[[2]])<-vnam }else if(clique.comembership==2){ census[[2]]<-array(census[[2]],dim=c(maxsize,n,n)) dimnames(census[[2]])<-list(1:maxsize,vnam,vnam) } #Return the non-null components pres<-c(TRUE,clique.comembership>0,enumerate>0) census[pres] } #component.dist - Returns a data frame containing a vector of length n such that #the ith element contains the number of components of G having size i, and a #vector of length n giving component membership. Component strength is #determined by the rule which is used to symmetrize the matrix; this controlled #by the eponymous parameter given to the symmetrize command. component.dist<-function(dat,connected=c("strong","weak","unilateral","recursive")){ #Pre-process the raw input if(match.arg(connected)%in%c("strong","weak","recursive")) dat<-as.edgelist.sna(dat) else dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,component.dist,connected=connected)) else if(length(dim(dat))>2) return(apply(dat,1,component.dist,connected=connected)) #End pre-processing #Begin routine #Proceed depending on the rule being used if(match.arg(connected)%in%c("strong","weak","recursive")){ #Strong, weak, recursive n<-attr(dat,"n") #Preprocess as needed dat<-switch(match.arg(connected), "weak"=symmetrize(dat,rule="weak",return.as.edgelist=TRUE), "strong"=symmetrize(reachability(dat,return.as.edgelist=TRUE),rule="strong", return.as.edgelist=TRUE), "recursive"=symmetrize(dat,rule="strong",return.as.edgelist=TRUE) ) #Find the component information using the leanest available method memb<-.C("undirComponents_R",as.double(dat),as.integer(n),as.integer(NROW(dat)), memb=integer(n+1),PACKAGE="sna",NAOK=TRUE)$memb csize<-tabulate(memb[-1],memb[1]) cdist<-rep(0,n) cdist[1:max(csize)]<-tabulate(csize,max(csize)) memb<-memb[-1] }else{ #Unilateral n<-dim(dat)[2] dat<-reachability(dat) #Warn of non-uniqueness in the unilateral case, if need be if(any(dat!=t(dat))) warning("Nonunique unilateral component partition detected in component.dist. Problem vertices will be arbitrarily assigned to one of their components.\n") #Find the membership information using a not-too-shabby method memb<-.C("component_dist_R",as.double(dat),as.double(n), memb=as.double(rep(0,n)),PACKAGE="sna",NAOK=TRUE)$memb csize<-tabulate(memb,max(memb)) cdist<-rep(0,n) cdist[1:max(csize)]<-tabulate(csize,max(csize)) } #Return the results o<-list(membership=memb,csize=csize,cdist=cdist) o } #component.largest - Extract the largest component from a graph component.largest<-function(dat,connected=c("strong","weak","unilateral", "recursive"), result=c("membership","graph"),return.as.edgelist=FALSE){ #Deal with network, array, or list data dat <- as.edgelist.sna(dat) if (is.list(dat)) return(lapply(dat, component.largest, connected = connected, result = result)) #We now have a single graph. Proceed accordingly. if(attr(dat,"n")==1){ if(match.arg(result)=="membership"){ return(TRUE) }else{ if(return.as.edgelist) return(dat) else return(as.sociomatrix.sna(dat)) } } cd<-component.dist(dat,connected=connected) lgcmp<-which(cd$csize==max(cd$csize)) #Get largest component(s) #Return the appropriate result if(match.arg(result)=="membership"){ cd$membership%in%lgcmp }else{ tokeep<-which(cd$membership%in%lgcmp) ovn<-attr(dat,"vnames") if(is.null(ovn)) ovn<-1:attr(dat,"n") if(return.as.edgelist){ sel<-rowSums(apply(dat,1:2,function(z){z%in%tokeep}))==2 dat<-dat[sel,,drop=FALSE] if(NROW(dat)>0){ dat[,1:2]<-apply(dat,1:2,function(z){match(z,tokeep)}) } attr(dat,"n")<-length(tokeep) attr(dat,"vnames")<-ovn[tokeep] dat }else{ as.sociomatrix.sna(dat)[tokeep,tokeep,drop=FALSE] } } } #component.size.byvertex component.size.byvertex<-function(dat, connected=c("strong","weak","unilateral","recursive")){ #Pre-process the input g<-as.edgelist.sna(dat) if(is.list(g)){ return(lapply(g,component.size.byvertex,connected=connected)) } #End pre-processing if(match.arg(connected)%in%c("weak","recursive")){ #We have a shortcut for these cases! if(match.arg(connected)=="weak") rule<-"weak" else rule<-"strong" g<-symmetrize(g,rule=rule, return.as.edgelist=TRUE) #Must symmetrize! cs<-.C("compsizes_R",as.double(g),as.integer(attr(g,"n")),as.integer(NROW(g)), csizes=integer(attr(g,"n")),PACKAGE="sna",NAOK=TRUE)$csizes }else{ #No shortcut. Sad! cd<-component.dist(dat,connected=match.arg(connected)) cs<-cd$csize[cd$membership] } #Return the results cs } #components - Find the number of (maximal) components within a given graph components<-function(dat,connected="strong",comp.dist.precomp=NULL){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,components,connected=connected, comp.dist.precomp=comp.dist.precomp)) #End pre-processing #Use component.dist to get the distribution if(!is.null(comp.dist.precomp)) cd<-comp.dist.precomp else cd<-component.dist(dat,connected=connected) #Return the result length(unique(cd$membership)) } #cutpoints - Find the cutpoints of an input graph cutpoints<-function(dat,mode="digraph",connected=c("strong","weak","recursive"),return.indicator=FALSE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,cutpoints,mode=mode,connected=connected, return.indicator=return.indicator)) #End pre-processing n<-attr(dat,"n") dat<-dat[dat[,1]!=dat[,2],] #Remove any loops, lest they break things attr(dat,"n")<-n cp<-rep(0,n) if(mode=="graph") cp<-.C("cutpointsUndir_R",as.double(dat),as.integer(n), as.integer(NROW(dat)),cp=as.integer(cp),NAOK=TRUE,PACKAGE="sna")$cp else{ dat<-switch(match.arg(connected), strong=dat, weak=symmetrize(dat,rule="weak",return.as.edgelist=TRUE), recursive=symmetrize(dat,rule="strong",return.as.edgelist=TRUE) ) if(match.arg(connected)=="strong") cp<-.C("cutpointsDir_R",as.double(dat),as.integer(n), as.integer(NROW(dat)),cp=as.integer(cp),NAOK=TRUE,PACKAGE="sna")$cp else cp<-.C("cutpointsUndir_R",as.double(dat),as.integer(n), as.integer(NROW(dat)),cp=as.integer(cp),NAOK=TRUE,PACKAGE="sna")$cp } if(!return.indicator) return(which(cp>0)) else{ if(is.null(attr(dat,"vnames"))) names(cp)<-1:n else names(cp)<-attr(dat,"vnames") return(cp>0) } } #geodist - Find the numbers and lengths of geodesics among nodes in a graph #using a BFS, a la Brandes (2008). Note that we still need N^2 storage, #although calculations are done on the edgelist (which should save some time). #Both valued and unvalued variants are possible -- don't use the valued #version unless you need to, since it can be considerably slower. geodist<-function(dat,inf.replace=Inf,count.paths=TRUE,predecessors=FALSE,ignore.eval=TRUE, na.omit=TRUE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,geodist,inf.replace=inf.replace,ignore.eval=ignore.eval)) #End pre-processing n<-attr(dat,"n") if(na.omit) sel<-!is.na(dat[,3]) else sel<-rep(TRUE,NROW(dat)) dat<-dat[(dat[,1]!=dat[,2])&sel,,drop=FALSE] m<-NROW(dat) #Initialize the matrices #Perform the calculation if(ignore.eval) geo<-.Call("geodist_R",dat,n,m,as.integer(1),count.paths,predecessors, PACKAGE="sna") else{ if(any(dat[!is.na(dat[,3]),3]<0)) stop("Negative edge values not currently supported in geodist; transform or otherwise alter them to ensure that they are nonnegative.") geo<-.Call("geodist_val_R",dat,n,m,as.integer(1),count.paths,predecessors, PACKAGE="sna") } #Return the results o<-list() if(count.paths) o$counts<-matrix(geo[[2]],n,n) o$gdist<-matrix(geo[[1]],n,n) o$gdist[o$gdist==Inf]<-inf.replace #Patch Infs, if desired if(predecessors) o$predecessors<-geo[[2+count.paths]] o } #isolates - Returns a list of the isolates in a given graph or stack isolates<-function(dat,diag=FALSE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,isolates,diag)) #End pre-processing n<-attr(dat,"n") if(!diag){ dat<-dat[dat[,1]!=dat[,2],,drop=FALSE] } which(tabulate(as.vector(dat[,1:2]),n)==0) } #is.connected - Determine whether or not one or more graphs are connected is.connected<-function(g,connected="strong",comp.dist.precomp=NULL){ #Pre-process the raw input g<-as.edgelist.sna(g) if(is.list(g)) return(lapply(g,is.connected,connected=connected, comp.dist.precomp=comp.dist.precomp)) #End pre-processing #Calculate numbers of components components(g,connected=connected,comp.dist.precomp=comp.dist.precomp)==1 } #is.isolate - Returns TRUE iff ego is an isolate is.isolate<-function(dat,ego,g=1,diag=FALSE){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat[g],is.isolate,ego=ego,g=1,diag=diag)) #End pre-processing if(!diag) dat<-dat[dat[,1]!=dat[,2],,drop=FALSE] dat<-dat[!is.na(dat[,3]),,drop=FALSE] noniso<-unique(c(dat[,1],dat[,2])) !(ego%in%noniso) } #kcores - Perform k-core decomposition of one or more input graphs kcores<-function(dat,mode="digraph",diag=FALSE,cmode="freeman",ignore.eval=FALSE){ #Pre-process the raw input dat<-as.edgelist.sna(dat,as.digraph=TRUE,suppress.diag=TRUE) if(is.list(dat)) return(lapply(dat,kcores,dat=dat,mode=mode,diag=diag,cmode=cmode, ignore.eval=ignore.eval)) #End pre-processing if(mode=="graph") #If undirected, force to "indegree" cmode<-"indegree" n<-attr(dat,"n") m<-NROW(dat) corevec<-1:n dtype<-switch(cmode, indegree=0, outdegree=1, freeman=2 ) if(!(cmode%in%c("indegree","outdegree","freeman"))) stop("Illegal cmode in kcores.\n") solve<-.C("kcores_R",as.double(dat),as.integer(n),as.integer(m), cv=as.double(corevec), as.integer(dtype), as.integer(diag), as.integer(ignore.eval), NAOK=TRUE,PACKAGE="sna") if(is.null(attr(dat,"vnames"))) names(solve$cv)<-1:n else names(solve$cv)<-attr(dat,"vnames") solve$cv } #kcycle.census - Compute the cycle census of a graph, possibly along with #additional information on the inidence of cycles. kcycle.census<-function(dat,maxlen=3,mode="digraph",tabulate.by.vertex=TRUE,cycle.comembership=c("none","sum","bylength")){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,kcycle.census,maxlen=maxlen,mode=mode, tabulate.by.vertex=tabulate.by.vertex,cycle.comembership=cycle.comembership)) #End pre-processing n<-attr(dat,"n") if(is.null(maxlen)) maxlen<-n if(maxlen<2) stop("maxlen must be >=2") if(is.null(attr(dat,"vnames"))) vnam<-paste("v",1:n,sep="") else vnam<-attr(dat,"vnames") if(mode=="digraph") directed<-TRUE else directed<-FALSE cocycles<-switch(match.arg(cycle.comembership), "none"=0, "sum"=1, "bylength"=2 ) #Generate the data structures for the counts if(!tabulate.by.vertex) count<-rep(0,maxlen-1) else count<-matrix(0,maxlen-1,n+1) if(!cocycles) cccount<-NULL else if(cocycles==1) cccount<-matrix(0,n,n) else cccount<-array(0,dim=c(maxlen-1,n,n)) if(is.null(maxlen)) maxlen<-n #Calculate the cycle information ccen<-.C("cycleCensus_R",as.integer(dat), as.integer(n), as.integer(NROW(dat)), count=as.double(count), cccount=as.double(cccount), as.integer(maxlen), as.integer(directed), as.integer(tabulate.by.vertex), as.integer(cocycles),PACKAGE="sna") #Coerce the cycle counts into the right form if(!tabulate.by.vertex){ count<-ccen$count names(count)<-2:maxlen }else{ count<-matrix(ccen$count,maxlen-1,n+1) rownames(count)<-2:maxlen colnames(count)<-c("Agg",vnam) } if(cocycles==1){ cccount<-matrix(ccen$cccount,n,n) rownames(cccount)<-vnam colnames(cccount)<-vnam }else if(cocycles==2){ cccount<-array(ccen$cccount,dim=c(maxlen-1,n,n)) dimnames(cccount)<-list(2:maxlen,vnam,vnam) } #Return the result out<-list(cycle.count=count) if(cocycles>0) out$cycle.comemb<-cccount out } #kpath.census - Compute the path census of a graph, possibly along with #additional information on the inidence of paths. kpath.census<-function(dat,maxlen=3,mode="digraph",tabulate.by.vertex=TRUE,path.comembership=c("none","sum","bylength"),dyadic.tabulation=c("none","sum","bylength")){ #Pre-process the raw input dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,kpath.census,maxlen=maxlen,mode=mode, tabulate.by.vertex=tabulate.by.vertex,path.comembership=path.comembership, dyadic.tabulation=dyadic.tabulation)) #End pre-processing n<-attr(dat,"n") if(is.null(maxlen)) maxlen<-n-1 if(maxlen<1) stop("maxlen must be >=1") if(is.null(attr(dat,"vnames"))) vnam<-paste("v",1:n,sep="") else vnam<-attr(dat,"vnames") if(mode=="digraph") directed<-TRUE else directed<-FALSE copaths<-switch(match.arg(path.comembership), "none"=0, "sum"=1, "bylength"=2 ) dyadpaths<-switch(match.arg(dyadic.tabulation), "none"=0, "sum"=1, "bylength"=2 ) #Generate the data structures for the counts if(!tabulate.by.vertex) count<-rep(0,maxlen) else count<-matrix(0,maxlen,n+1) if(!copaths) cpcount<-NULL else if(copaths==1) cpcount<-matrix(0,n,n) else cpcount<-array(0,dim=c(maxlen,n,n)) if(!dyadpaths) dpcount<-NULL else if(dyadpaths==1) dpcount<-matrix(0,n,n) else dpcount<-array(0,dim=c(maxlen,n,n)) #Calculate the path information pcen<-.C("pathCensus_R",as.double(dat), as.integer(n), as.integer(NROW(dat)), count=as.double(count), cpcount=as.double(cpcount), dpcount=as.double(dpcount), as.integer(maxlen), as.integer(directed), as.integer(tabulate.by.vertex), as.integer(copaths), as.integer(dyadpaths),PACKAGE="sna") #Coerce the path counts into the right form if(!tabulate.by.vertex){ count<-pcen$count names(count)<-1:maxlen }else{ count<-matrix(pcen$count,maxlen,n+1) rownames(count)<-1:maxlen colnames(count)<-c("Agg",vnam) } if(copaths==1){ cpcount<-matrix(pcen$cpcount,n,n) rownames(cpcount)<-vnam colnames(cpcount)<-vnam }else if(copaths==2){ cpcount<-array(pcen$cpcount,dim=c(maxlen,n,n)) dimnames(cpcount)<-list(1:maxlen,vnam,vnam) } if(dyadpaths==1){ dpcount<-matrix(pcen$dpcount,n,n) rownames(dpcount)<-vnam colnames(dpcount)<-vnam }else if(dyadpaths==2){ dpcount<-array(pcen$dpcount,dim=c(maxlen,n,n)) dimnames(dpcount)<-list(1:maxlen,vnam,vnam) } #Return the result out<-list(path.count=count) if(copaths>0) out$path.comemb<-cpcount if(dyadpaths>0) out$paths.bydyad<-dpcount out } #maxflow - Return the matrix of maximum flows between positions maxflow<-function(dat,src=NULL,sink=NULL,ignore.eval=FALSE){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,maxflow,src=src,sink=sink,ignore.eval=ignore.eval)) else if(length(dim(dat))>2) return(apply(dat,1,maxflow,src=src,sink=sink,ignore.eval=ignore.eval)) #End pre-processing n<-NROW(dat) dat[is.na(dat)]<-0 #Deal with values and missingness if(ignore.eval) dat[dat!=0]<-1 if(length(src)==0) #Define sources and sinks src<-1:n else src<-src[(src>0)&(src<=n)] if(length(sink)==0) sink<-1:n else sink<-sink[(sink>0)&(sink<=n)] fmat<-matrix(nrow=length(src),ncol=length(sink)) for(i in 1:length(src)) for(j in 1:length(sink)) fmat[i,j]<-.C("maxflow_EK_R",as.double(dat),as.integer(NROW(dat)), as.integer(src[i]-1),as.integer(sink[j]-1),flow=as.double(0),NAOK=TRUE,PACKAGE="sna")$flo #Return the result if(length(src)*length(sink)>1){ if(is.null(rownames(dat))) rownames(fmat)<-src else rownames(fmat)<-rownames(dat)[src] if(is.null(colnames(dat))) colnames(fmat)<-sink else colnames(fmat)<-colnames(dat)[sink] }else fmat<-as.numeric(fmat) fmat } #neighborhood - Return the matrix of n-th order neighbors for an input graph neighborhood<-function(dat,order,neighborhood.type=c("in","out","total"),mode="digraph",diag=FALSE,thresh=0,return.all=FALSE,partial=TRUE){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,neighborhood,order=order, neighborhood.type=neighborhood.type,mode=mode,diag=diag,thresh=thresh,return.all=return.all,partial=partial)) else if(length(dim(dat))>2) return(apply(dat,1,neighborhood,order=order, neighborhood.type=neighborhood.type,mode=mode,diag=diag,thresh=thresh,return.all=return.all,partial=partial)) #End pre-processing dat<-dat>thresh #Dichotomize at threshold #Adjust the graph to take care of symmetry or neighborhood type issues if((mode=="graph")||(match.arg(neighborhood.type)=="total")) dat<-dat|t(dat) if(match.arg(neighborhood.type)=="in") dat<-t(dat) #Extract the neighborhood graphs geo<-geodist(dat) if(return.all){ #Return all orders? neigh<-array(dim=c(order,NROW(dat),NROW(dat))) for(i in 1:order){ neigh[i,,]<-switch(partial+1, geo$gdist<=i, #!partial -> order i or less geo$gdist==i #partial -> exactly order i ) if(!diag) diag(neigh[i,,])<-0 } }else{ #Don't return all orders neigh<-switch(partial+1, geo$gdist<=order, geo$gdist==order ) if(!diag) diag(neigh)<-0 } #Return the result neigh } #reachability - Find the reachability matrix of a graph. reachability<-function(dat,geodist.precomp=NULL,return.as.edgelist=FALSE,na.omit=TRUE){ #Pre-process the raw input if(!is.null(geodist.precomp)){ #Might as well use a matrix, and not repeat the BFS! dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,reachability,geodist.precomp=geodist.precomp, return.as.edgelist=return.as.edgelist,na.omit=na.omit)) else if(length(dim(dat))>2) return(unlist(apply(dat,1,function(x,geodist.precomp,return.as.edgelist,na.omit){list(reachability(x, geodist.precomp=geodist.precomp, return.as.edgelist=return.as.edgelist, na.omit=na.omit))}, geodist.precomp=geodist.precomp, return.as.edgelist=return.as.edgelist, na.omit=na.omit),recursive=FALSE)) }else{ #Starting from scratch - use the sparse version dat<-as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat,reachability,geodist.precomp=geodist.precomp, return.as.edgelist=return.as.edgelist,na.omit=na.omit)) } #End pre-processing if(!is.null(geodist.precomp)){ #Get the counts matrix cnt<-geodist.precomp$counts #Dichotomize and return if(!return.as.edgelist) apply(cnt>0,c(1,2),as.numeric) else as.edgelist.sna(apply(cnt>0,c(1,2),as.numeric)) }else{ n<-attr(dat,"n") if(na.omit) sel<-!is.na(dat[,3]) else sel<-rep(TRUE,NROW(dat)) dat<-dat[(dat[,1]!=dat[,2])&sel,,drop=FALSE] m<-NROW(dat) rg<-.Call("reachability_R",dat,n,m,PACKAGE="sna") if(return.as.edgelist) rg else as.sociomatrix.sna(rg) } } #Function to compute the Simmelian ties for one or more input networks. # Arguments: # dat - one or more input networks, in any form recognized by as.edgelist.sna # dichotomize - logical; should we report whether each dyad has a Simmelian tie? # Otherwise, the count of three-clique co-memberships for each dyad is used as # an edge value. # return.as.edgelist - logical; return the result as an sna edgelist? # # Return value: # Either an adjacency matrix or sna edgelist containing the Simmelian tie structure; # if multiple networks are supplied, a list of results is returned. # simmelian<-function(dat, dichotomize=TRUE, return.as.edgelist=FALSE){ #Regularize the inputs dat <- as.edgelist.sna(dat) if(is.list(dat)) return(lapply(dat, simmelian, dichotomize = dichotomize)) #Symmetrize the network g <- symmetrize(dat, rule="strong", return.as.edgelist=TRUE) #Compute the 3-cycle co-memberships ccen <- kcycle.census(g, mode="graph", tabulate.by.vertex=FALSE, cycle.comembership="bylength") if(dichotomize) comemb <- ccen$cycle.comemb[2,,]>0 else comemb <- ccen$cycle.comemb[2,,] diag(comemb) <- 0 #Return the result if(return.as.edgelist) as.edgelist.sna(comemb) else comemb } #structure.statistics - Return the structure statistics for a given graph structure.statistics<-function(dat,geodist.precomp=NULL){ #Pre-process the raw input dat<-as.sociomatrix.sna(dat) if(is.list(dat)) return(lapply(dat,structure.statistics,geodist.precomp=geodist.precomp)) else if(length(dim(dat))>2) return(apply(dat,1,structure.statistics,geodist.precomp=geodist.precomp)) #End pre-processing #Get the geodesic distance matrix if(is.null(geodist.precomp)) gd<-geodist(dat)$gdist else gd<-geodist.precomp$gdist #Compute the reachability proportions for each vertex ss<-vector() for(i in 1:NROW(dat)) ss[i]<-mean(apply(gd<=i-1,1,mean)) names(ss)<-0:(NROW(dat)-1) ss } sna/COPYING0000644000176200001440000000147110501711233012062 0ustar liggesusers sna Package for R - Tools for Social Network Analysis Copyright (C) 2005 Carter T. Butts This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA sna/data/0000755000176200001440000000000012115030515011735 5ustar liggesuserssna/data/coleman.RData0000644000176200001440000000227411177264577014325 0ustar liggesusers‹íÜËnG†áö`%€Dd)W‘]ܧ!+6Q$¶É†­B² ‚;â ¹D˜þ‚ íéCþªzÉvÁ´çë™®ú]}˜þûÏõ㫪ÚU»GÃ÷Có|7|;«ª‹á?ªŸÿ}{ýêæêvxì—ªúícUˆgŸ¶=©ò½¿kjÌe°Çêø̵ZÉ0_¨ñJ]à‹ÕùwRßÔ#À>Æé]ß¿¼/° u%ȵŸO̓r}½þ“Êy±ïëõ °oj¼†>þ²ôùS­/©®7ð#¡û3ó SNÕêëbÍ«BçPýb¾Œ¦Žÿºîwôg \©œsõ¼±ë\ì|À²XóžÐuûIé[Z?¶.?÷x|¨ë ØÖ 5Ž\Õ‹Sëëû<¡•úgUn¯?·×“ WuiíñWó£µëïk~æ‹Õñ‘ÛøÍåu–0®–áýû!@º¿ó¤v)ð­Üûcé×SÆ>ÿ|‹þg›«ûÓùÊ¡ÿvX¾êN¬×gå}àã»,lï²X?Þbu½€÷óõùe׿êy×>ÀŸ\ÆŸëÒµõþìïpÅ÷ý ¦r¬Ô +ëàÿ¶Ö'«õÆÊú)›{6ß÷µ }Ÿª­¨?@º|ß2Ô}4CËmþ•ÛëA\[Y=?êùœY?±ö£¬|ÞÃÊý€û”ÒCÚzÿò­N=õ÷IýïWªÇq}kõ(µþsQ×XçëxÙÒùõ˜úø¤Ê÷ý¸ÏàNèû€X—˔퟇Է#õ(®¹ó ×Ç{N­~Œ÷iÞ¿¸Ö~Þdí®ó¬Ju½1ï¿ï¾~íõ˾ŽçÌ]¯¹óέËÏ]OÆ·-l›\o—­uÂUΩ¼¹õÈÕòXë|7|;«ª‹GÃÏ/ßÜ ?žšÃ×á¡ç_¿î,öpXìöêæÕ‡¡ýëqÙ‹ãò‡ÇÏÿºº¾>¶úçÝû7·¯K # Last Modified 12/13/20 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Portions taken from the NetStat library by Carter T. Butts (2002) # (self-licensed under GPL) # # Part of the R/sna package # # This file contains various utility routines to be called by other # sna functions. # ###################################################################### */ #include "utils.h" /*MATH ROUTINES-----------------------------------------------------------*/ void aggarray3d_R(double *a, double *w, double *mat, int *m, int *n) /*This is equivalent to mat<-apply(sweep(a,1,w,"*"),c(2,3)), i.e. it performs a simple weighted aggregation of a 3-dimensional array. This operation can be surprisingly slow in R for large matrices, and hence is backended here.*/ { int i,j,k; for(i=0;i<*n;i++) for(j=0;j<*n;j++){ mat[i+j*(*n)]=0.0; for(k=0;k<*m;k++) if(!ISNAN(a[k+i*(*m)+j*(*m)*(*n)])) mat[i+j*(*n)]+=w[k]*a[k+i*(*m)+j*(*m)*(*n)]; } } void dyadcode_R(double *mat, int *n, int *m, double *dc) /*This little routine maps every edge in the (3-column) sna edgelist *mat to a unique dyad number (stored in dc), reflecting an upper-triangular representation. This is useful when trying to identify edges from the same dyad. This can be done within R, but C is a lot faster. Presumably.*/ { int i; double nd=(double)(*n); for(i=0;i<*m;i++){ dc[i]=((mat[i]n=(*n); g->indeg=(int *)R_alloc(g->n,sizeof(int)); g->outdeg=(int *)R_alloc(g->n,sizeof(int)); g->iel=(slelement **)R_alloc(g->n,sizeof(slelement *)); g->oel=(slelement **)R_alloc(g->n,sizeof(slelement *)); /*Initialize the graph*/ for(i=0;i<*n;i++){ g->indeg[i]=0; g->outdeg[i]=0; g->iel[i]=NULL; g->oel[i]=NULL; } /*Add the edges*/ for(i=0;i<*n;i++) for(j=0;j<*n;j++) if((!ISNAN(mat[i+j*(*n)]))&&(mat[i+j*(*n)]!=0.0)){ dval=(double *)R_alloc(1,sizeof(double)); /*Create iel element*/ dval[0]=mat[i+j*(*n)]; g->iel[j]=slistInsert(g->iel[j],(double)i,(void *)dval); g->indeg[j]++; dval=(double *)R_alloc(1,sizeof(double)); /*Create oel element*/ dval[0]=mat[i+j*(*n)]; g->oel[i]=slistInsert(g->oel[i],(double)j,(void *)dval); g->outdeg[i]++; } /*Return the result*/ return g; } snaNet *elMatTosnaNet(double *mat, int *n, int *m) /*Given an edgelist matrix, create a snaNet object. This matrix must be in three-column form, as sender/receiver/value; undirected graphs should be passed as fully mutual digraphs. The specified edge values are stored within the snaNet object, in double form.*/ { snaNet *g; int i; double *dval; // Rprintf("Entering elMattosnaNet, n=%d, m=%d\n",*n,*m); /*Allocate memory for the new object*/ g=(snaNet *)R_alloc(1,sizeof(struct snaNettype)); g->n=(*n); g->indeg=(int *)R_alloc(g->n,sizeof(int)); g->outdeg=(int *)R_alloc(g->n,sizeof(int)); g->iel=(slelement **)R_alloc(g->n,sizeof(slelement *)); g->oel=(slelement **)R_alloc(g->n,sizeof(slelement *)); /*Initialize the graph*/ for(i=0;i<*n;i++){ g->indeg[i]=0; g->outdeg[i]=0; g->iel[i]=NULL; g->oel[i]=NULL; } /*Add the edges*/ for(i=0;i<*m;i++){ // Rprintf("\tEdge %d: %.0f->%.0f (%.0f)\n",i,mat[i],mat[i+(*m)], mat[i+2*(*m)]); dval=(double *)R_alloc(1,sizeof(double)); /*Create iel element*/ dval[0]=mat[i+2*(*m)]; g->iel[(int)mat[i+(*m)]-1]=slistInsert(g->iel[(int)mat[i+(*m)]-1], mat[i]-1.0,(void *)dval); // slistPrint(g->iel[(int)mat[i+(*m)]-1]); g->indeg[(int)mat[i+(*m)]-1]++; dval=(double *)R_alloc(1,sizeof(double)); /*Create oel element*/ dval[0]=mat[i+2*(*m)]; g->oel[(int)mat[i]-1]=slistInsert(g->oel[(int)mat[i]-1],mat[i+(*m)]-1.0, (void *)dval); // slistPrint(g->oel[(int)mat[i]-1]); g->outdeg[(int)mat[i]-1]++; } /*Return the result*/ // Rprintf("Finished elMatTosnaNet\n"); return g; } slelement *snaFirstEdge(snaNet *g, int i, int type) /*Return a pointer to the edge alter in i's incoming edgelist (type=0) or outgoing edgelist (type=1). This is just a convenience function, but helps avoid some awkward code in places.*/ { if(type){ /*Outgoing edge list*/ if(g->oel[i]==NULL) return NULL; else return g->oel[i]->next[0]; }else{ /*Incoming edge list*/ if(g->iel[i]==NULL) return NULL; else return g->iel[i]->next[0]; } return NULL; /*Should never get here*/ } int snaIsAdjacent(int i, int j, snaNet *g, int checkna) /*Determine whether i sends an edge to j. If checkna==0, missingness is ignored when checking (i.e., we just see if an edge is in the database). If checkna==1, then missingness is checked and an NA_INTEGER is returned if the edge has a missing value. If checkna==2, then missingness is also checked, but the edge is reported as absent if it has a missing value.*/ { slelement *sep; if(g->indeg[j]>g->outdeg[i]){ /*Check shortest available list*/ switch(checkna){ case 0: /*Don't check*/ return isInSList(g->oel[i],(double)j); break; case 1: /*Return NA if missing*/ sep=slistSearch(g->oel[i],(double)j); if(sep==NULL) return 0; if((sep->dp==NULL)||ISNAN(*((double *)(sep->dp)))) return NA_INTEGER; return 1; break; case 2: /*Return 0 if missing*/ sep=slistSearch(g->oel[i],(double)j); if(sep==NULL) return 0; if((sep->dp==NULL)||ISNAN(*((double *)(sep->dp)))) return 0; return 1; break; } }else{ switch(checkna){ case 0: /*Don't check*/ return isInSList(g->iel[j],(double)i); break; case 1: /*Return NA if missing*/ sep=slistSearch(g->iel[j],(double)i); if(sep==NULL) return 0; if((sep->dp==NULL)||ISNAN(*((double *)(sep->dp)))) return NA_INTEGER; return 1; break; case 2: /*Return 0 if missing*/ sep=slistSearch(g->iel[j],(double)i); if(sep==NULL) return 0; if((sep->dp==NULL)||ISNAN(*((double *)(sep->dp)))) return 0; return 1; break; } } /*Should never get here*/ warning("Illegal call in snaIsAdjacent. Reporting 0.\n"); return 0; } /*QUEUE/STACK/LIST ROUTINES-------------------------------------------------*/ /*Skip Lists (Ascending)*/ int isInSList(slelement *head, double val) /*Is val in the skip list pointed to by head?*/ { slelement *ep; int i; /*Return immediately if no list*/ if(head==NULL) return 0; /*Otherwise, go looking for trouble*/ ep=head; for(i=head->depth;i>=0;i--) for(;(ep->next[i]!=NULL)&&(ep->next[i]->valnext[i]); /*We have reached the end of the line; check to see where we are*/ if((ep->next[0]==NULL)||(ep->next[0]->val>val)) return 0; return 1; } slelement *slistDelete(slelement *head, double val) /*Remove the first element matching val from the list, if present (otherwise, leave things intact). A pointer to the deleted element is returned (or NULL if not found); note that we do not have to return a pointer to the list, since the head will remain unchanged regardless. (This means that empty lists are not NULLed out, for what that's worth.)*/ { slelement *ep,**epp,**tochange,*rp; int i,olddepth; // Rprintf("\tTrying to delete item with val %.1f\n",val); /*Return immediately if no list*/ if(head==NULL) return NULL; /*Try to delete val*/ tochange=(slelement **)R_alloc(head->depth+1,sizeof(slelement *)); ep=head; for(i=head->depth;i>=0;i--){ /*Filter down*/ for(;(ep->next[i]!=NULL)&&(ep->next[i]->valnext[i]); tochange[i]=ep; /*Record the last element at each level*/ } /*We have reached the end of the line; is there a value here to delete?*/ if((ep->next[0]==NULL)||(ep->next[0]->val>val)) return NULL; // Rprintf("\t\tStopped search at %.1f\n",ep->next[0]->val); rp=ep->next[0]; /*Apparently, ep->next[0] should be scheduled for demolition*/ for(i=0;i<=head->depth;i++){ /*Update pointers from search trace*/ if(tochange[i]->next[i]!=rp) /*Nothing deeper goes here*/ break; tochange[i]->next[i]=rp->next[i]; /*Always depth-safe*/ } /*Update the maximum list depth and the list length*/ // Rprintf("\t\tNew length %.0f, old depth %d\n",head->val-1,head->depth); head->val--; olddepth=head->depth; for(;(head->depth>0)&&(head->next[head->depth]==NULL);head->depth--); // Rprintf("\t\t\tNew depth %d\n",head->depth); if(head->depth!=olddepth){ epp=head->next; head->next=(slelement **)R_alloc(head->depth+1,sizeof(slelement *)); for(i=0;i<=head->depth;i++) head->next[i]=epp[i]; } /*Return the item pointer*/ // Rprintf("\t\tAbout to return item %.1f\n",rp->val); return rp; } slelement *slistInsert(slelement *head, double val, void *dp) /*Add the indicated item to a list, returning a pointer to the updated head (which might have been changed, if called with NULL). Note that the return value will simply be head unless except in the case noted above.*/ { slelement *ep,*new,**tochange,**epp; int i; /*Create the new element*/ new=(slelement *)R_alloc(1,sizeof(slelement)); new->depth=(int)rgeom(0.5); new->next=(slelement **)R_alloc(new->depth+1,sizeof(slelement *)); new->val=val; new->dp=dp; /*Add it to the list*/ if(head==NULL){ /*If no list, create from whole cloth....*/ head=(slelement *)R_alloc(1,sizeof(slelement)); head->val=1.0; head->dp=NULL; head->depth=new->depth; head->next=(slelement **)R_alloc(head->depth+1,sizeof(slelement *)); for(i=0;i<=head->depth;i++){ /*Head -> new, new -> NULL*/ head->next[i]=new; new->next[i]=NULL; } }else{ /*Otherwise, insert in place*/ head->val++; /*Increment the list length indicator*/ tochange=(slelement **)R_alloc(MAX(new->depth,head->depth)+1, sizeof(slelement *)); ep=head; for(i=head->depth;i>=0;i--){ for(;(ep->next[i]!=NULL)&&(ep->next[i]->valnext[i]); tochange[i]=ep; /*Record the last element at each level*/ } if(new->depth>head->depth){ /*For new levels, head is last element*/ epp=head->next; head->next=(slelement **)R_alloc(new->depth+1,sizeof(slelement *)); for(i=0;i<=head->depth;i++) head->next[i]=epp[i]; for(i=head->depth+1;i<=new->depth;i++){ tochange[i]=head; head->next[i]=NULL; } head->depth=new->depth; } for(i=0;i<=new->depth;i++){ /*Adjust pointers for leftward elements*/ new->next[i]=tochange[i]->next[i]; tochange[i]->next[i]=new; } } /*Return the possibly updated head pointer*/ return head; } void slistPrint(slelement *head) /*Troubleshooting utility to print the contents of an slist.*/ { slelement *ep,*ep2; int count=0,i,j; Rprintf("SkipList Printout:\n"); if(head==NULL) Rprintf("\tEmpty list.\n"); else{ for(ep=head;ep!=NULL;ep=ep->next[0]){ Rprintf(" %d: [%.1f] ",count++,ep->val); for(i=0;i<=ep->depth;i++){ for(j=0,ep2=head;(ep2!=NULL)&&(ep->next[i]!=ep2);ep2=ep2->next[0]) j++; Rprintf("--%03d",j); } Rprintf("\n"); } } Rprintf("--------------------\n"); } slelement *slistSearch(slelement *head, double val) /*Return a pointer to the first element matching val, or else NULL.*/ { slelement *ep; int i; /*Return immediately if no list*/ if(head==NULL) return NULL; /*Otherwise, go looking for trouble*/ ep=head; for(i=head->depth;i>=0;i--) for(;(ep->next[i]!=NULL)&&(ep->next[i]->valnext[i]); /*We have reached the end of the line; check to see where we are*/ if((ep->next[0]==NULL)||(ep->next[0]->val>val)) return NULL; return ep->next[0]; } /*Linked Lists (Ascending)*/ int isInList(element *head, double val) /*Is val in the sorted list pointed to by head?*/ { element *ep; for(ep=head;(ep!=NULL)&&(ep->valnext); if(ep==NULL) return 0; if(ep->val==val) return 1; return 0; } element *listInsert(element *head, double val, void *dp) /*Add a new element to a sorted list, returning a pointer to the updated list.*/ { element *elem,*ep; /*Initialize the element*/ elem=(element *)R_alloc(1,sizeof(struct elementtype)); elem->val=val; elem->dp=dp; elem->next=NULL; if(head==NULL){ /*If this is the only element, make it the head*/ return elem; }else if(head->val>val){ /*If this is first, make it the head*/ elem->next=head; return elem; }else{ /*Otherwise, traverse until we get to the right spot*/ for(ep=head;(ep->next!=NULL)&&(ep->next->valnext); if(ep->next==NULL){ /*We ran out of list, apparently*/ ep->next=elem; return head; }else{ /*We need to add elem after ep*/ elem->next=ep->next; ep->next=elem; return head; } } } /*Stacks*/ element pop(element *head) /*Pop an element from the stack pointed to by head*/ { element rval; if(head==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=head; }else{ if(head->next==NULL){ rval.val=head->val; rval.dp=head->dp; head=NULL; rval.next=NULL; }else{ rval.next=head->next; rval.val=head->val; rval.dp=head->dp; head=rval.next; } } return rval; } element *push(element *head, double val, void *dp) /*Adds element with value val to the stack, returning the head pointer.*/ { element *newnode; /*Create the new entry*/ newnode=(element *)R_alloc(1,sizeof(struct elementtype)); newnode->val=val; /*Set the element value*/ newnode->dp=dp; /*Set the next pointer equal to the current first entry (if any)*/ newnode->next=head; /*Place the new node at the head of the stack*/ head=newnode; return head; } element *pushCalloc(element *head, double val, void *dp) /*Adds element with value val to the stack, returning the head pointer. This function uses R_alloc for memory allocation, so memory allocated is automatically freed by R at the end of the .C call.*/ { element *newnode; /*Create the new entry*/ newnode=(element *)R_alloc(1,sizeof(struct elementtype)); newnode->val=val; /*Set the element value*/ newnode->dp=dp; /*Set the next pointer equal to the current first entry (if any)*/ newnode->next=head; /*Place the new node at the head of the stack*/ head=newnode; return head; } long int stacklen(element *head) /*Returns the length of the stack pointed to by head*/ { element *p; int count=0; for(p=head;p!=NULL;p=p->next) count++; return count; } char isinstack(element *head,double val) /*Returns a 1 if val is in the stack pointed to by head, otherwise 0*/ { element *p; for(p=head;p!=NULL;p=p->next) if(p->val==val) return 1; return 0; } element stackdel(element *head,double val) /*! Find the element val in the stack pointed to by head and delete it, returning the deleted element.*/ { element rval,*p; if(head==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=NULL; }else if(head->val==val){ rval.val=head->val; rval.dp=head->dp; rval.next=head->next; head=rval.next; }else{ for(p=head;(p->next!=NULL)&&(p->next->val!=val);p=p->next); if(p->next==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=NULL; }else{ rval.val=p->next->val; rval.dp=p->next->dp; rval.next=p->next->next; p->next=rval.next; } } return rval; } /*Queues*/ element dequeue(element *head) /*Dequeue an element from the queue pointed to by head*/ { element rval,*p; if(head==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=head; }else{ if(head->next==NULL){ rval.val=head->val; rval.dp=head->dp; head=NULL; rval.next=NULL; }else{ for(p=head;p->next->next!=NULL;p=p->next); rval.next=NULL; rval.val=p->next->val; rval.dp=p->next->dp; p->next=NULL; } } return rval; } element *enqueue(element *head, double val, void *dp) /*Adds element with value val to the queue, returning the head pointer.*/ { element *newnode; /*Create the new entry*/ newnode=(element *)R_alloc(1,sizeof(struct elementtype)); newnode->val=val; /*Set the element value*/ newnode->dp=dp; /*Set the next pointer equal to the current first entry (if any)*/ newnode->next=head; /*Place the new node at the head of the queue*/ head=newnode; return head; } long int queuelen(element *head) /*Returns the length of the queue pointed to by head*/ { element *p; int count=0; for(p=head;p!=NULL;p=p->next) count++; return count; } char isinqueue(element *head,double val) /*Returns a 1 if val is in the queue pointed to by head, otherwise 0*/ { element *p; for(p=head;p!=NULL;p=p->next) if(p->val==val) return 1; return 0; } element queuedel(element *head,double val) /*Find the element val in the queue pointed to by head and delete it, returning the deleted element.*/ { element rval,*p; if(head==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=NULL; }else if(head->val==val){ rval.val=head->val; rval.dp=head->dp; rval.next=head->next; head=rval.next; }else{ for(p=head;(p->next!=NULL)&&(p->next->val!=val);p=p->next); if(p->next==NULL){ rval.val=-1.0; rval.dp=NULL; rval.next=NULL; }else{ rval.val=p->next->val; rval.dp=p->next->dp; rval.next=p->next->next; p->next=rval.next; } } return rval; } sna/src/cohesion.c0000644000176200001440000007620314533477274013625 0ustar liggesusers/* ###################################################################### # # cohesion.c # # copyright (c) 2007, Carter T. Butts # Last Modified 8/28/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the identification of # cohesive subgroups. # ###################################################################### */ #include #include #include #include "cohesion.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ void bicomponentRecurse(snaNet *g, element *complist, element *estack, int *parent, int *num, int *back, int *dfn, int v) /*Perform a depth-first recusion to identify bicomponents. This call implements a visit to v. Components are stored as vertex lists, in an element list with the following structure: dp-> (last component) | head -next-> component1 -next> ... | | | val val dp-> elem -next-> ... (#comps) (#vert) | val (vert ID) Bicomponents are accumulated through their edges; these are stored in *estack until needed. val is used to store both endpoints, via the following encoding scheme: (i,j) -> k=i+n*j; k -> (i=k%n,j=floor(k/n)) estack itself is of the form head -next-> edge1 -next-> ... | val (i+n*j) The use of the fixed head element allows the stack to be passed around during recursion without ill effects. Just remember that the stack's lead pointer is estack->next. (Note: ultimately, it would be nice to handle biblocks (the bicomponents in digraphs) and bijoin points (articulation points in digraphs bijoin point).) */ { element *es,*es2,*cp; slelement *ep; int vj,flag,n,vert; //Rprintf("\tEntered bicomp recursion for %d.\n",v); n=g->n; es=estack; /*Update counters*/ num[v]=back[v]=(++(*dfn)); /*Recursively seek cutpoints*/ for(ep=snaFirstEdge(g,v,1);ep!=NULL;ep=ep->next[0]){ /*Walk v's neighbors*/ if(((int)ep->val!=v)&&((int)ep->val!=parent[v])){ vj=(int)ep->val; if(num[vj]==0){ /*We're seeing vj for the first time*/ es->next=push(es->next,v+(double)vj*n,NULL); /*This is a tree edge*/ parent[vj]=v; bicomponentRecurse(g,complist,es,parent,num,back,dfn,vj); //Rprintf("Returned from bicomp recursion (%d to %d).\n",v,vj); //Rprintf("\tback[%d]=%d, num[%d]=%d\n",vj,back[vj],v,num[v]); if(back[vj]>=num[v]){ /*Create/insert new component*/ cp=(element *)R_alloc(1,sizeof(element)); cp->dp=NULL; cp->next=NULL; cp->val=0.0; if((int)complist->val==0){ complist->next=cp; }else{ ((element *)(complist->dp))->next=cp; } complist->dp=(void *)cp; complist->val++; /*Add vertices to component*/ flag=0; //Rprintf("\tFound backedge with (%d,%d); popping stack.\n",v,vj); for(es2=es->next;(es2!=NULL)&&(!flag);es2=es2->next){ //Rprintf("\t\t(%d,%d)\n",(int)(es2->val) % n, (int)floor((es2->val)/((double)n))); if(es2->val==(double)v+(double)vj*n) /*Check to see if we've pulled last edge*/ flag++; if(!flag){ vert=(int)fmod(es2->val,(double)n); if(!isinstack((element *)(cp->dp),vert)){ cp->dp=(void *)listInsert((element *)(cp->dp),vert,NULL); cp->val++; } vert=(int)floor((es2->val)/((double)n)); if(!isinstack((element *)(cp->dp),vert)){ cp->dp=(void *)listInsert((element *)(cp->dp),vert,NULL); cp->val++; } } } es->next=es2; /*Remove popped edges from stack (R will deallocate)*/ }else{ //Rprintf("\tSetting back[%d]=%d\n",v,MIN(back[v],back[vj])); back[v]=MIN(back[v],back[vj]); } }else if((num[vj]next=push(es->next,(double)v+(double)vj*n,NULL); back[v]=MIN(num[vj],back[v]); } } } } slelement *cliqueFirstChild(snaNet *g, slelement *cl) /*Given the "seed" clique in cl, find the (lexically) first maximal clique containing cl. Note that cl is "expanded" into the new clique, and is thus changed in place. A pointer to cl is superfluously returned.*/ { slelement *i,*ep,*ep2; /*Check to see if we were called with an empty list*/ if((cl==NULL)||(cl->val==0.0)) return cl; /*Index the first existing clique entry*/ ep=cl->next[0]; /*If the first element is an isolate, return; else, search within the*/ /*neighbors of the first element (since this is much smaller than n!).*/ if(g->outdeg[(int)(ep->val)]==0) return cl; i=g->oel[(int)(ep->val)]->next[0]; while(i!=NULL){ /*If i is equal to the currently indexed clique element, advance both*/ while((ep!=NULL)&&(i->val==ep->val)){ i=i->next[0]; ep=ep->next[0]; } /*Otherwise, test for adjacency*/ if(i!=NULL){ for(ep2=cl->next[0];(ep2!=NULL)&& snaIsAdjacent((int)(i->val),(int)(ep2->val),g,2); ep2=ep2->next[0]); /*If we got to the end, add i->val to the clique*/ if(ep2==NULL) cl=slistInsert(cl,i->val,NULL); } /*Increment i*/ i=i->next[0]; } /*Return a pointer to the updated clique (should not have changed)*/ return cl; } void cliqueRecurse(snaNet *g, slelement *k, int parind, element **clist, double *ccount, int *compmemb) /*Recursive clique enumeration, using the algorithm of Makino and Uno (2004) (with some implementation differences). k should contain (as an slist) the clique to evaluate -- it is stored, and all lexical descendents are then computed. Cliques are stored in clist, which must be a vector of stacks of length n. clist[i] is then the stack of cliques of length i+1; the cliques themselves are stored as slists within said stacks. The vector ccount should likewise be an n-vector, and is used to store the number of cliques of each size so far enumerated. It should be initialized to zero, obviously. Finally, parind is the "parent index" of k, which is used in the recursion process. To enumerate all cliques within a component, call this function with the lexically first clique in the component, and a parind of the lead vertex number. (Because this algorithm doesn't work properly across components, one must also pass a vector of component memberships. compmemb is assumed to be such an indicator vector, shifted forward by 1 (so that the ith vertex in *g reckoning is in the i+1th position), as returned by undirComponents.)*/ { int i,j,flag,cm; slelement *kc,*ep,*ep2; /*0th step: see if we need to exit*/ R_CheckUserInterrupt(); /*First, store k and update ccount*/ clist[(int)(k->val)-1]=push(clist[(int)(k->val)-1],k->val,(void *)k); ccount[(int)(k->val)-1]++; /*Try finding "child" cliques using all non-k members > parind*/ cm=compmemb[(int)(k->next[0]->val)+1]; for(i=parind+1;in;i++) if((cm==compmemb[i+1])&&(!isInSList(k,(double)i))){ /*Create candidate seed*/ kc=slistInsert(NULL,(double)i,NULL); /*i U {k[k<=i] int N(i)}*/ for(ep=k->next[0];(ep!=NULL)&&(ep->val<=(double)i);ep=ep->next[0]) if(snaIsAdjacent(i,(int)(ep->val),g,2)) kc=slistInsert(kc,ep->val,NULL); /*Now, test to see if kc produces a child of k*/ j=flag=0; /*"Lemma 3" condition*/ ep=kc->next[0]; while((jval)){ j++; ep=ep->next[0]; } /*Test to see if j adjacent to all seed elements*/ if(jnext[0];flag&&(ep2!=NULL);ep2=ep2->next[0]) if(!snaIsAdjacent(j,(int)(ep2->val),g,2)) flag--; } /*Increment j*/ j++; } j=0; /*"Lemma 4" condition*/ ep=k->next[0]; while((jval)){ j++; ep=ep->next[0]; } /*Test to see if j adjacent to all k<=j*/ if(jnext[0];flag&&(ep2!=NULL)&&(ep2->val<=(double)j); ep2=ep2->next[0]) if(!snaIsAdjacent(j,(int)(ep2->val),g,2)) flag--; } /*If we got this far, test to see if j adjacent to non-i seeds*/ if((jnext[0];flag&&(ep2!=NULL);ep2=ep2->next[0]) if(((int)(ep2->val)!=i)&&(!snaIsAdjacent(j,(int)(ep2->val),g,2))) flag--; } /*Increment j*/ j++; } /*If both tests were passed, then create the child clique and recurse*/ if(!flag){ kc=cliqueFirstChild(g,kc); /*Get first clique containing seed nodes*/ cliqueRecurse(g,kc,i,clist,ccount,compmemb);/*Recurse on kc, parind=i*/ } } } void cutpointUndirRecurse(snaNet *g, int *cpstatus, int *minvis, int *visdep, int depth, int v, int src) /*Perform a depth-first recusion to identify cutpoints in undirected graphs. This call implements a visit from src to v; for the search root, use src=-1. On the initial pass, visdep and mindis should be 0, as should depth and cpstatus.*/ { slelement *ep; int vj,ccount=0; /*Update counters*/ minvis[v]=visdep[v]=(++depth); /*Recursively seek cutpoints*/ for(ep=snaFirstEdge(g,v,1);ep!=NULL;ep=ep->next[0]) /*Walk v's neighbors*/ if((int)ep->val!=src){ vj=(int)ep->val; if(visdep[vj]==0){ /*Is vj unvisited?*/ if((visdep[v]==1)&&(++ccount>1)) /*Root node w/>1 child*/ cpstatus[v]=1; cutpointUndirRecurse(g,cpstatus,minvis,visdep,depth,vj,v); minvis[v]=MIN(minvis[v],minvis[vj]); if((visdep[v]!=1)&&(minvis[vj]>=visdep[v])) cpstatus[v]=1; }else minvis[v]=MIN(minvis[v],visdep[vj]); /*If shorter path, note it*/ } } /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP bicomponents_R(SEXP net, SEXP sn, SEXP sm) { snaNet *g; int *parent,*num,*back,*dfn,i,j,n,count,pc=0; element *complist,*ep,*ep2,*es; SEXP bicomps,bcl,memb,outlist; /*Coerce what needs coercin'*/ //Rprintf("Initial coercion\n"); PROTECT(sn=coerceVector(sn,INTSXP)); pc++; PROTECT(sm=coerceVector(sm,INTSXP)); pc++; PROTECT(net=coerceVector(net,REALSXP)); pc++; n=INTEGER(sn)[0]; /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(REAL(net),INTEGER(sn),INTEGER(sm)); /*Calculate the sorting stat*/ parent=(int *)R_alloc(n,sizeof(int)); num=(int *)R_alloc(n,sizeof(int)); back=(int *)R_alloc(n,sizeof(int)); dfn=(int *)R_alloc(1,sizeof(int)); for(i=0;ival=0.0; complist->next=NULL; complist->dp=NULL; /*Walk the graph components, finding bicomponents*/ es=(element *)R_alloc(1,sizeof(element)); for(i=0;inext=NULL; bicomponentRecurse(g,complist,es,parent,num,back,dfn,i); } /*Transfer information from complist to output vector*/ //Rprintf("Gathering components...\n"); count=(int)complist->val; PROTECT(outlist=allocVector(VECSXP,2)); pc++; PROTECT(bicomps=allocVector(VECSXP,count)); pc++; PROTECT(memb=allocVector(INTSXP,n)); pc++; for(i=0;inext; for(i=0;ival)); j=0; for(ep2=(element *)ep->dp;ep2!=NULL;ep2=ep2->next){ INTEGER(bcl)[j++]=(int)ep2->val+1; INTEGER(memb)[(int)ep2->val]=i+1; } SET_VECTOR_ELT(bicomps,i,bcl); UNPROTECT(1); ep=ep->next; } SET_VECTOR_ELT(outlist,0,bicomps); SET_VECTOR_ELT(outlist,1,memb); /*Unprotect and return*/ PutRNGstate(); UNPROTECT(pc); return outlist; } SEXP cliques_R(SEXP net, SEXP sn, SEXP sm, SEXP stabulatebyvert, SEXP scomembership, SEXP senumerate) /*Maximal clique enumeration as an R-callable (.Call) function. net should be an sna edgelist (w/n vertices and m/2 edges), and must be pre-symmetrized. stabulatebyvert should be 0 if no tabulation is to be performed, or 1 for vertex-level tabulation of clique membership. scomembership should be 0 for no co-membership tabulation, 1 for aggregate vertex-by-vertex tabulation, and 2 for size-by-vertex-by-vertex tabulation. Finally, senumerate should be 1 iff the enumerated clique list should be returned. (The current algorithm enumerates them internally, regardless. This is b/c I am lazy, and didn't fold all of the tabulation tasks into the recursion process. Life is hard.)*/ { int n,tabulate,comemb,enumerate,*gotcomp,*compmemb,i,j,k,maxcsize,pc=0; double *ccount,*pccountvec,*pcocliquevec=NULL; snaNet *g; slelement *sep,*sep2,*k0; element **clist,*ep; SEXP smaxcsize,ccountvec,outlist,cliquevec=R_NilValue; SEXP temp=R_NilValue,sp=R_NilValue,cocliquevec=R_NilValue; /*Coerce what needs coercin'*/ PROTECT(sn=coerceVector(sn,INTSXP)); pc++; PROTECT(net=coerceVector(net,REALSXP)); pc++; PROTECT(stabulatebyvert=coerceVector(stabulatebyvert,INTSXP)); pc++; PROTECT(scomembership=coerceVector(scomembership,INTSXP)); pc++; PROTECT(senumerate=coerceVector(senumerate,INTSXP)); pc++; n=INTEGER(sn)[0]; tabulate=INTEGER(stabulatebyvert)[0]; comemb=INTEGER(scomembership)[0]; enumerate=INTEGER(senumerate)[0]; /*Pre-allocate what needs pre-allocatin'*/ ccount=(double *)R_alloc(n,sizeof(double)); PROTECT(smaxcsize=allocVector(INTSXP,1)); pc++; clist=(element **)R_alloc(n,sizeof(element *)); for(i=0;i=0)&(INTEGER(smaxcsize)[0]==n+1);i--) if(ccount[i]>0.0) INTEGER(smaxcsize)[0]=i+1; maxcsize=INTEGER(smaxcsize)[0]; /*Allocate memory for R return value objects*/ if(tabulate){ PROTECT(ccountvec=allocVector(REALSXP,maxcsize*(1+n))); pc++; for(i=0;i0.0){ if(enumerate) sp=VECTOR_ELT(cliquevec,i); /*Walk through every clique of size i+1*/ for(j=0,ep=clist[i];ep!=NULL;ep=ep->next){ if(enumerate) PROTECT(temp=allocVector(INTSXP,i+1)); /*Walk through every clique member*/ for(k=0,sep=((slelement *)(ep->dp))->next[0];sep!=NULL; sep=sep->next[0]){ if(enumerate) /*Add to enumeration list*/ INTEGER(temp)[k++]=(int)(sep->val)+1; if(tabulate) /*Add to vertex-by-size tabulation*/ pccountvec[i+maxcsize*((int)(sep->val))]++; switch(comemb){ /*Add co-membership information*/ case 0: /*Case 0 - do nothing*/ break; case 1: /*Case 1 - just co-membership*/ for(sep2=((slelement *)(ep->dp))->next[0];sep2!=sep; sep2=sep2->next[0]){ pcocliquevec[((int)(sep->val))+n*((int)(sep2->val))]++; pcocliquevec[((int)(sep2->val))+n*((int)(sep->val))]++; } pcocliquevec[((int)(sep->val))+n*((int)(sep->val))]++; break; case 2: /*Case 2 - co-membership by size*/ for(sep2=((slelement *)(ep->dp))->next[0];sep2!=sep; sep2=sep2->next[0]){ pcocliquevec[i+maxcsize*((int)(sep->val))+ maxcsize*n*((int)(sep2->val))]++; pcocliquevec[i+maxcsize*((int)(sep2->val))+ maxcsize*n*((int)(sep->val))]++; } pcocliquevec[i+maxcsize*((int)(sep->val))+ maxcsize*n*((int)(sep->val))]++; break; } } if(enumerate){ SET_VECTOR_ELT(sp,j++,temp); UNPROTECT(1); } } } } /*Prepare and return the results*/ PROTECT(outlist=allocVector(VECSXP,4)); pc++; SET_VECTOR_ELT(outlist,0,smaxcsize); SET_VECTOR_ELT(outlist,1,ccountvec); SET_VECTOR_ELT(outlist,2,cocliquevec); SET_VECTOR_ELT(outlist,3,cliquevec); UNPROTECT(pc); return outlist; } void cutpointsDir_R(double *mat, int *n, int *m, int *cpstatus) /*Compute (strong) cutpoints in a directed graph. mat should be the edgelist matrix (of order n), and cpstatus should be a zero-initialized vectors to contain the cutpoint status (0=not a cutpoint, 1=cutpoint). Lacking a good algorithm, I've used something horribly slow and ugly -- nevertheless, it will get the job done for graphs of typical size. Although this should work fine with undirected graphs, it will be hideously slow...use the undirected variant wherever possible.*/ { snaNet *g; int i,j,ccount,ccountwoi,tempideg,tempodeg; slelement *sep,*tempiel,*tempoel,**tempentries; //Rprintf("Now in cutpointsDir_R. Setting up snaNet\n"); /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); for(i=0;i<*n;i++){ cpstatus[i]=0; } /*Walk the vertices, finding cutpoints by brute force*/ ccount=numStrongComponents(g,n); //Rprintf("Original number of components: %d\n",ccount); for(i=0;i<*n;i++) if((g->indeg[i]>0)&&(g->outdeg[i]>0)){ /*Must be internal to a path*/ //Rprintf("\tEntering with %d\n",i); /*Temporarily make i an isolate*/ //Rprintf("\tMoving out %d's edges\n",i); tempideg=g->indeg[i]; tempodeg=g->outdeg[i]; tempiel=g->iel[i]; tempoel=g->oel[i]; g->indeg[i]=0; g->outdeg[i]=0; g->iel[i]=NULL; g->oel[i]=NULL; tempentries=(slelement **)R_alloc(tempideg,sizeof(slelement *)); //Rprintf("\tMoving out %d edges pointing to %d\n",tempideg,i); if(tempiel==NULL) sep=NULL; else sep=tempiel->next[0]; for(j=0;sep!=NULL;sep=sep->next[0]){ /*Remove edges pointing to i*/ //Rprintf("\t\t%d, about to do slistDelete\n",j); tempentries[j++]=slistDelete(g->oel[(int)(sep->val)],(double)i); //Rprintf("\t\tSending vertex is %d\n",(int)(sep->val)); //Rprintf("\t\t%d, about to do decrement outdegrees\n",j); /*Decrement outdegree*/ //Rprintf("\t\toutdegree is %d\n", g->outdeg[(int)(sep->val)]); g->outdeg[(int)(sep->val)]--; //Rprintf("\t\tnew outdegree is %d\n", g->outdeg[(int)(sep->val)]); //Rprintf("\t%d -> %d [%.1f]\n",(int)(sep->val), (int)(tempentries[j-1]->val), *((double *)(tempentries[j-1]->dp))); //Rprintf("\t\tfinished tracer\n"); } /*Recalculate components (told you this was ugly!)*/ ccountwoi=numStrongComponents(g,n)-1; /*Remove 1 for i*/ //Rprintf("\tNumber of components w/out %d: %d\n",i,ccountwoi); if(ccountwoi>ccount) cpstatus[i]++; /*Restore i to its former glory*/ g->indeg[i]=tempideg; g->outdeg[i]=tempodeg; g->iel[i]=tempiel; g->oel[i]=tempoel; //Rprintf("\tRestoring edges to %d\n",i); if(tempiel==NULL) sep=NULL; else sep=tempiel->next[0]; for(j=0;sep!=NULL;sep=sep->next[0]){ /*Restore edges->i*/ g->oel[(int)(sep->val)]=slistInsert(g->oel[(int)(sep->val)],(double)i, tempentries[j++]->dp); /*Increment outdegree*/ g->outdeg[(int)(sep->val)]++; //Rprintf("\t\tnew outdegree is %d\n", g->outdeg[(int)(sep->val)]); //Rprintf("\t%d -> %d [%.1f]\n",(int)(sep->val), (int)(tempentries[j-1]->val), *(double*)(tempentries[j-1]->dp)); } } PutRNGstate(); } void cutpointsUndir_R(double *mat, int *n, int *m, int *cpstatus) /*Compute cutpoints in an undirected graph. mat should be edgelist matrix (of order n, w/m edges), and cpstatus should be a zero-initialized vectors to contain the cutpoint status (0=not a cutpoint, 1=cutpoint). The standard DFS method is used here -- this will _not_ work for non-mutual digraphs, but is much faster than the currently implemented digraph method. Use this whenever appropriate!*/ { snaNet *g; int *minvis,*visdep,i; // Rprintf("Now in cutpointsUndir_R. Setting up snaNet\n"); /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); /*Initialize cutpoint/visit structures*/ // Rprintf("Initializing\n"); minvis=(int *)R_alloc(*n,sizeof(int)); visdep=(int *)R_alloc(*n,sizeof(int)); for(i=0;i<*n;i++){ cpstatus[i]=minvis[i]=visdep[i]=0; } /*Walk the graph components, finding cutpoints*/ // Rprintf("Finding cutpoints\n"); for(i=0;i<*n;i++) if(visdep[i]==0) cutpointUndirRecurse(g,cpstatus,minvis,visdep,0,i,-1); // Rprintf("Returning\n"); PutRNGstate(); } void kcores_R(double *mat, int *n, int *m, double *corevec, int *dtype, int *pdiag, int *pigeval) /*Compute k-cores for an input graph. Cores to be computed can be based on indegree (dtype=0), outdegree (dtype=1), or total degree (dtype=2). Algorithm used is based on Batagelj and Zaversnik (2002), with some pieces filled in. It's quite fast -- for large graphs, far more time is spent processing the input than computing the k-cores! When processing edge values, igeval determines whether edge values should be ignored (0) or used (1); missing edges are not counted in either case. When diag=1, diagonals are used; else they are also omitted.*/ { int i,j,k,temp,*ord,*nod,diag,igev; double *stat; snaNet *g; slelement *ep; diag=*pdiag; igev=*pigeval; /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); PutRNGstate(); /*Calculate the sorting stat*/ stat=(double *)R_alloc(*n,sizeof(double)); switch(*dtype){ case 0: /*Indegree*/ for(i=0;i<*n;i++){ stat[i]=0.0; for(ep=snaFirstEdge(g,i,0);ep!=NULL;ep=ep->next[0]) if(((diag)||(i!=(int)(ep->val)))&&((ep->dp!=NULL)&&(!ISNAN(*(double *)(ep->dp))))) stat[i]+= igev ? *((double *)(ep->dp)) : 1.0; } break; case 1: /*Outdegree*/ for(i=0;i<*n;i++){ stat[i]=0.0; for(ep=snaFirstEdge(g,i,1);ep!=NULL;ep=ep->next[0]) if(((diag)||(i!=(int)(ep->val)))&&((ep->dp!=NULL)&&(!ISNAN(*(double *)(ep->dp))))) stat[i]+= igev ? *((double *)(ep->dp)) : 1.0; } break; case 2: /*Total degree*/ for(i=0;i<*n;i++){ stat[i]=0.0; for(ep=snaFirstEdge(g,i,0);ep!=NULL;ep=ep->next[0]) if(((diag)||(i!=(int)(ep->val)))&&((ep->dp!=NULL)&&(!ISNAN(*(double *)(ep->dp))))) stat[i]+= igev ? *((double *)(ep->dp)) : 1.0; for(ep=snaFirstEdge(g,i,1);ep!=NULL;ep=ep->next[0]) if(((diag)||(i!=(int)(ep->val)))&&((ep->dp!=NULL)&&(!ISNAN(*(double *)(ep->dp))))) stat[i]+= igev ? *((double *)(ep->dp)) : 1.0; } break; } /*Set initial core/order values*/ ord=(int *)R_alloc(*n,sizeof(int)); nod=(int *)R_alloc(*n,sizeof(int)); for(i=0;i<*n;i++){ corevec[i]=stat[i]; ord[i]=nod[i]=i; } /*Heap reminder: i->(2i+1, 2i+2); parent at floor((i-1)/2); root at 0*/ /*Build a heap, based on the stat vector*/ for(i=1;i<*n;i++){ j=i; while(j>0){ k=(int)floor((j-1)/2); /*Parent node*/ if(stat[nod[k]]>stat[nod[j]]){ /*Out of order -- swap*/ temp=nod[k]; nod[k]=nod[j]; nod[j]=temp; ord[nod[j]]=j; ord[nod[k]]=k; } j=k; /*Move to parent*/ } } /*Heap test for(i=0;i<*n;i++){ Rprintf("Pos %d (n=%d, s=%.0f, check=%d): ",i,nod[i],stat[nod[i]],ord[nod[i]]==i); j=(int)floor((i-1)/2.0); if(j>=0) Rprintf("Parent %d (n=%d, s=%.0f), ",j,nod[j],stat[nod[j]]); else Rprintf("No Parent (root), "); j=2*i+1; if(j<*n) Rprintf("Lchild %d (n=%d, s=%.0f), ",j,nod[j],stat[nod[j]]); else Rprintf("No Lchild, "); j=2*i+2; if(j<*n) Rprintf("Rchild %d (n=%d, s=%.0f)\n",j,nod[j],stat[nod[j]]); else Rprintf("No Rchild\n"); } */ /*Now, find the k-cores*/ for(i=*n-1;i>=0;i--){ /*Rprintf("Stack currently spans positions 0 to %d.\n",i);*/ corevec[nod[0]]=stat[nod[0]]; /*Coreness of top element is fixed*/ /*Rprintf("Pulled min vertex (%d): coreness was %.0f\n",nod[0],corevec[nod[0]]);*/ /*Swap root w/last element (and re-heap) to remove it*/ temp=nod[0]; nod[0]=nod[i]; nod[i]=temp; ord[nod[0]]=0; ord[nod[i]]=i; j=0; while(2*j+1 update out-neighbors*/ /*Rprintf("Reducing indegree of %d outneighbors...\n",g->outdeg[nod[i]]);*/ for(ep=snaFirstEdge(g,nod[i],1);ep!=NULL;ep=ep->next[0]){ j=(int)ep->val; if(ord[j]",j,stat[j]);*/ stat[j]=MAX(stat[j]-*((double *)(ep->dp)),corevec[nod[i]]); /*Rprintf(" %.0f\n",stat[j]);*/ /*Percolate heap upward (stat can only go down!)*/ j=ord[j]; while(floor((j-1)/2)>=0){ k=floor((j-1)/2); /*Parent node*/ if(stat[nod[k]]>stat[nod[j]]){ /*If parent greater, swap*/ temp=nod[j]; nod[j]=nod[k]; nod[k]=temp; ord[nod[j]]=j; ord[nod[k]]=k; }else break; j=k; /*Repeat w/new parent*/ } } } break; case 1: /*Outdegree -> update in-neighbors*/ for(ep=snaFirstEdge(g,nod[i],0);ep!=NULL;ep=ep->next[0]){ j=(int)ep->val; if(ord[j]",j,stat[j]);*/ stat[j]=MAX(stat[j]-*((double *)(ep->dp)),corevec[nod[i]]); /*Rprintf(" %.0f\n",stat[j]);*/ /*Percolate heap upward (stat can only go down!)*/ j=ord[j]; while(floor((j-1)/2)>=0){ k=floor((j-1)/2); /*Parent node*/ if(stat[nod[k]]>stat[nod[j]]){ /*If parent greater, swap*/ temp=nod[j]; nod[j]=nod[k]; nod[k]=temp; ord[nod[j]]=j; ord[nod[k]]=k; }else break; j=k; /*Repeat w/new parent*/ } } } break; case 2: /*Total degree -> update all neighbors*/ for(ep=snaFirstEdge(g,nod[i],1);ep!=NULL;ep=ep->next[0]){ j=(int)ep->val; if(ord[j]",j,stat[j]);*/ stat[j]=MAX(stat[j]-*((double *)(ep->dp)),corevec[nod[i]]); /*Rprintf(" %.0f\n",stat[j]);*/ /*Percolate heap upward (stat can only go down!)*/ j=ord[j]; while(floor((j-1)/2)>=0){ k=floor((j-1)/2); /*Parent node*/ if(stat[nod[k]]>stat[nod[j]]){ /*If parent greater, swap*/ temp=nod[j]; nod[j]=nod[k]; nod[k]=temp; ord[nod[j]]=j; ord[nod[k]]=k; }else break; j=k; /*Repeat w/new parent*/ } } } for(ep=snaFirstEdge(g,nod[i],0);ep!=NULL;ep=ep->next[0]){ j=(int)ep->val; if(ord[j]",j,stat[j]);*/ stat[j]=MAX(stat[j]-*((double *)(ep->dp)),corevec[nod[i]]); /*Rprintf(" %.0f\n",stat[j]);*/ /*Percolate heap upward (stat can only go down!)*/ j=ord[j]; while(floor((j-1)/2)>=0){ k=floor((j-1)/2); /*Parent node*/ if(stat[nod[k]]>stat[nod[j]]){ /*If parent greater, swap*/ temp=nod[j]; nod[j]=nod[k]; nod[k]=temp; ord[nod[j]]=j; ord[nod[k]]=k; }else break; j=k; /*Repeat w/new parent*/ } } } break; } } } sna/src/geodist.c0000644000176200001440000004747514533477263013463 0ustar liggesusers/* ###################################################################### # # geodist.c # # copyright (c) 2004, Carter T. Butts # Last Modified 7/15/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the computation of geodesics. # ###################################################################### */ #include #include #include #include "geodist.h" void spsp(int ego, snaNet *g, double *gd, double *sigma, element **pred, int *npred, int checkna) /* Solve the single-pair shortest-path problem for ego the graph in g. The geodesic distances are stored in gd, and the path counts in sigma (both being n-vectors). Predecessors are contained as a vector of lists in pred, with ego's entry instead containing the vertices encountered (as a stack). Treatment of missing data is determined by checkna; 0 implies no NA checking (missing edges treated as present), and 1 or 2 results in omission of missing edges. */ { element *tovisit,*v,*last,*ep; slelement *w; int n,i,vv,wv; /*Set up stuff*/ n=g->n; for(i=0;ival); if(last==tovisit) last=NULL; tovisit=v->next; npred[ego]++; pred[ego]=push(pred[ego],(double)vv,NULL); /*Walk the out-neighborhood of v*/ for(w=snaFirstEdge(g,vv,1);w!=NULL;w=w->next[0]) if((!checkna)||((w->dp!=NULL)&&(!ISNAN(*(double *)(w->dp))))){ wv=(int)(w->val); if(gd[wv]==R_PosInf){ gd[wv]=gd[vv]+1.0; /*Insert at the end using a custom adjustment*/ ep=(element *)R_alloc(1,sizeof(element)); ep->val=w->val; ep->dp=NULL; ep->next=NULL; if(last!=NULL) last->next=ep; else tovisit=ep; last=ep; } if(gd[wv]==gd[vv]+1.0){ sigma[wv]+=sigma[vv]; pred[wv]=push(pred[wv],(double)vv, NULL); npred[wv]++; } } } } void spsp_val(int ego, snaNet *g, double *gd, double *sigma, element **pred, int *npred, int checkna) /* Compute a single-pair shortest-path solution for the valued graph in g. The geodesic distances are stored in gd, and the path counts in sigma (both being n-vectors). Predecessors are stored as an n-vector of lists (pred), with ego's entry instead containing the vertices encountered (as a stack). Treatment of missing data is determined by checkna; 0 implies no NA checking (missing edges treated as present), and 1 or 2 results in omission of missing edges. */ { element *tovisit,*v,*ep,*ep2; slelement *w; int n,i,*x,vv,wv; double ev; n=g->n; for(i=0;inext; vv=*((int *)(v->dp)); pred[ego]=push(pred[ego],(double)vv,NULL); npred[ego]++; /*Walk the out-neighborhood of v*/ for(w=snaFirstEdge(g,vv,1);w!=NULL;w=w->next[0]) if((!checkna)||((w->dp!=NULL)&&(!ISNAN(*(double *)(w->dp))))){ ev=*((double *)(w->dp)); wv=(int)(w->val); if(gd[wv]>gd[vv]+ev){ /*Set new shortest distance*/ gd[wv]=gd[vv]+ev; /*Reset sigma and pred*/ sigma[wv]=0.0; npred[wv]=0; pred[wv]=NULL; /*If w not in queue, add it; else, update its position*/ if(tovisit==NULL){ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[wv],(void *)x); }else if(tovisit->next==NULL){ if(*(int *)(tovisit->dp)==wv){ tovisit->val=gd[wv]; }else{ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[wv],(void *)x); } }else{ /*Look for w*/ for(ep=tovisit; (ep->next!=NULL) && ((*(int *)(ep->next->dp))!=wv); ep=ep->next); /*If w not in queue, add it in order*/ if(ep->next==NULL){ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[wv],(void *)x); }else{ /*Else, update and re-insert*/ ep2=ep->next; ep->next=ep2->next; ep2->val=gd[wv]; if(ep2->val<=tovisit->val){ ep2->next=tovisit; tovisit=ep2; }else{ for(ep=tovisit;(ep->next!=NULL)&&(ep->next->valval); ep=ep->next); if(ep->next==NULL){ ep2->next=NULL; ep->next=ep2; }else{ ep2->next=ep->next; ep->next=ep2; } } } } } /*Increment the number of shortest paths, if needed*/ if(gd[wv]==gd[vv]+ev){ sigma[wv]+=sigma[vv]; npred[wv]++; pred[wv]=push(pred[wv],(double)vv,NULL); } } } } void geodist_adj_R(double *g, double *pn, double *gd, double *sigma) /* Compute geodesics for the adjacency matrix in g. The geodesic distances are stored in gd, and the path counts in sigma (both being nxn matrices). Note that these should be initialized to all infs and all 0s, respectively. (This function is a holdover, as it processes the network in adjacency form. I'm leaving it for now, however, in case it is needed for something.) */ { char *visited; long int n,v,i,nod,s1count; /*Set up stuff*/ n=*pn; /*Allocate memory for visited list*/ visited=(char *)R_alloc(n,sizeof(char)); /*Cycle through each node, performing a BFS*/ for(v=0;v0){ while(s1count>0){ /*Find the next visitable node, and change its state*/ for(nod=0;visited[nod]!=1;nod++); /*Only OK b/c s1count>0*/ visited[nod]=3; s1count--; for(i=0;i=g[nod+i*n]){ gd[v+i*n]=gd[v+nod*n]+g[nod+i*n]; /*Geodist is nod's+g*/ sigma[v+i*n]+=sigma[v+nod*n]; /*Add to path count*/ } } } /*Continue until we run out of nodes for this iteration*/ /*Mark all "to-be-visited" nodes as visitable*/ for(i=0;ival); if(last==tovisit) last=NULL; tovisit=v->next; if(calcpred){ npred[i]++; pred[i]=push(pred[i],(double)vv,NULL); } /*Walk the out-neighborhood of v*/ for(w=snaFirstEdge(g,vv,1);w!=NULL;w=w->next[0]) if((!checkna)||((w->dp!=NULL)&&(!ISNAN(*(double *)(w->dp))))){ wv=(int)(w->val); if(gd[i+n*wv]==R_PosInf){ gd[i+n*wv]=gd[i+n*vv]+1.0; /*Insert at the end using a custom adjustment*/ ep=(element *)R_alloc(1,sizeof(element)); ep->val=w->val; ep->dp=NULL; ep->next=NULL; if(last!=NULL) last->next=ep; else tovisit=ep; last=ep; } if(gd[i+n*wv]==gd[i+n*vv]+1.0){ if(calcsig) sigma[i+n*wv]+=sigma[i+n*vv]; if(calcpred){ pred[wv]=enqueue(pred[wv],(double)vv, NULL); npred[wv]++; } } } } /*Store predecessory lists if collecting*/ if(calcpred){ PROTECT(predl=allocVector(VECSXP,n)); for(j=0;j0){ PROTECT(pl=allocVector(INTSXP,npred[j])); for(k=0,ep=pred[j];ep!=NULL;ep=ep->next) INTEGER(pl)[k++]=(int)(ep->val)+1; SET_VECTOR_ELT(predl,j,pl); UNPROTECT(1); }else SET_VECTOR_ELT(predl,j,R_NilValue); } SET_VECTOR_ELT(allpredl,i,predl); UNPROTECT(1); } /*Unprotect locally allocated memory*/ vmaxset(vmax); } /*Prepare and return the results*/ PROTECT(outlist=allocVector(VECSXP,3)); pc++; SET_VECTOR_ELT(outlist,0,sgd); if(calcsig) SET_VECTOR_ELT(outlist,1,ssigma); else SET_VECTOR_ELT(outlist,1,R_NilValue); if(calcsig) SET_VECTOR_ELT(outlist,2,allpredl); else SET_VECTOR_ELT(outlist,2,R_NilValue); UNPROTECT(pc); return outlist; } SEXP geodist_val_R(SEXP mat, SEXP sn, SEXP sm, SEXP scheckna, SEXP scalcsig, SEXP scalcpred) /* Compute geodesics for the valued graph in mat. The results are returned as a list of objects: an nxn distance matrix (gd), an nxn matrix of path counts (sigma), and a list of lists of predecessor vectors. Calculation of the latter two can be suppressed via use of the scalcsig and scalcpred arguments (respectively). Treatment of missing data is determined by checkna; 0 implies no NA checking (missing edges treated as present), and 1 or 2 results in omission of missing edges. */ { snaNet *g; element *tovisit,*v,*ep,*ep2,**pred=NULL; slelement *w; int n,i,j,k,*x,vv,wv,*npred=NULL,pc=0,checkna,calcpred,calcsig; double ev,*gd,*sigma=NULL; SEXP sgd,ssigma=R_NilValue,allpredl=R_NilValue,predl=R_NilValue,outlist,pl; const void *vmax; /*Coerce inputs*/ PROTECT(mat=coerceVector(mat,REALSXP)); pc++; PROTECT(sn=coerceVector(sn,INTSXP)); pc++; PROTECT(sm=coerceVector(sm,INTSXP)); pc++; PROTECT(scheckna=coerceVector(scheckna,INTSXP)); pc++; PROTECT(scalcpred=coerceVector(scalcpred,INTSXP)); pc++; PROTECT(scalcsig=coerceVector(scalcsig,INTSXP)); pc++; checkna=INTEGER(scheckna)[0]; calcpred=INTEGER(scalcpred)[0]; calcsig=INTEGER(scalcsig)[0]; n=INTEGER(sn)[0]; /*Allocate memory for outputs*/ PROTECT(sgd=allocVector(REALSXP,n*n)); pc++; gd=REAL(sgd); if(calcsig){ PROTECT(ssigma=allocVector(REALSXP,n*n)); pc++; sigma=REAL(ssigma); } if(calcpred){ PROTECT(allpredl=allocVector(VECSXP,n)); pc++; pred=(element **)R_alloc(n,sizeof(element *)); npred=(int *)R_alloc(n,sizeof(int)); } /*Set up stuff*/ GetRNGstate(); g=elMatTosnaNet(REAL(mat),INTEGER(sn),INTEGER(sm)); PutRNGstate(); for(i=0;inext; vv=*((int *)(v->dp)); if(calcpred){ npred[i]++; pred[i]=push(pred[i],(double)vv,NULL); } /*Walk the out-neighborhood of v*/ for(w=snaFirstEdge(g,vv,1);w!=NULL;w=w->next[0]) if((!checkna)||((w->dp!=NULL)&&(!ISNAN(*(double *)(w->dp))))){ ev=*((double *)(w->dp)); wv=(int)(w->val); if(gd[i+n*wv]>gd[i+n*vv]+ev){ /*Set new shortest distance*/ gd[i+n*wv]=gd[i+n*vv]+ev; /*Reset sigma and predecessor lists, if needed*/ if(calcsig) sigma[i+n*wv]=0.0; if(calcpred){ npred[wv]=0; pred[wv]=NULL; } /*If w not in queue, add it; else, update its position*/ if(tovisit==NULL){ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[i+n*wv],(void *)x); }else if(tovisit->next==NULL){ if(*(int *)(tovisit->dp)==wv){ tovisit->val=gd[i+n*wv]; }else{ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[i+n*wv],(void *)x); } }else{ /*Look for w*/ for(ep=tovisit; (ep->next!=NULL) && ((*(int *)(ep->next->dp))!=wv); ep=ep->next); /*If w not in queue, add it in order*/ if(ep->next==NULL){ x=(int *)R_alloc(1,sizeof(int)); x[0]=wv; tovisit=listInsert(tovisit,gd[i+n*wv],(void *)x); }else{ /*Else, update and re-insert*/ ep2=ep->next; ep->next=ep2->next; ep2->val=gd[i+n*wv]; if(ep2->val<=tovisit->val){ ep2->next=tovisit; tovisit=ep2; }else{ for(ep=tovisit;(ep->next!=NULL)&&(ep->next->valval); ep=ep->next); if(ep->next==NULL){ ep2->next=NULL; ep->next=ep2; }else{ ep2->next=ep->next; ep->next=ep2; } } } } } /*Increment the number of shortest paths, if needed*/ if(gd[i+n*wv]==gd[i+n*vv]+ev){ if(calcsig) sigma[i+n*wv]+=sigma[i+n*vv]; if(calcpred){ npred[wv]++; pred[wv]=push(pred[wv],(double)vv,NULL); } } } } /*Store predecessory lists if collecting*/ if(calcpred){ PROTECT(predl=allocVector(VECSXP,n)); for(j=0;j0){ PROTECT(pl=allocVector(INTSXP,npred[j])); for(k=0,ep=pred[j];ep!=NULL;ep=ep->next) INTEGER(pl)[k++]=(int)(ep->val)+1; SET_VECTOR_ELT(predl,j,pl); UNPROTECT(1); }else SET_VECTOR_ELT(predl,j,R_NilValue); } SET_VECTOR_ELT(allpredl,i,predl); UNPROTECT(1); } /*Unprotect locally allocated memory*/ vmaxset(vmax); } /*Prepare and return the results*/ PROTECT(outlist=allocVector(VECSXP,3)); pc++; SET_VECTOR_ELT(outlist,0,sgd); if(calcsig) SET_VECTOR_ELT(outlist,1,ssigma); else SET_VECTOR_ELT(outlist,1,R_NilValue); if(calcsig) SET_VECTOR_ELT(outlist,2,allpredl); else SET_VECTOR_ELT(outlist,2,R_NilValue); UNPROTECT(pc); return outlist; } void maxflow_EK_R(double *g,int *pn,int *psource,int *psink,double *flow) /* Determine the maxmimum flow from source to sink using the Edmonds-Karp algorithm. (This implementation is an adaptation of one provided on Wikipedia (entry: "Edmonds-Karp algorithm," 4/18/09), for what it's worth.) */ { int i,j,t,n,p,q,source,sink,flag,*pre,*que; double *fmat,*d,f; n=*pn; source=*psource; sink=*psink; /*Rprintf("Entered with source %d, sink %d\n",source,sink);*/ if(source==sink) /*If source==sink, just set to infinity and exit*/ *flow=R_PosInf; else{ /*Alas, looks like we'll have to do some work!*/ /*Initialize everything*/ fmat=(double *)R_alloc(n*n,sizeof(double)); pre=(int *)R_alloc(n,sizeof(int)); que=(int *)R_alloc(n,sizeof(int)); d=(double *)R_alloc(n,sizeof(double)); for(i=0;i0){ fmat[pre[i]-1+i*n]+=d[sink]; i=pre[i]-1; }else{ fmat[i+(-pre[i]-1)*n]-=d[sink]; i=-pre[i]-1; } } } } for(f=0.0,i=0;i # Last Modified 7/18/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the computation of node level # indices (NLIs). # ###################################################################### */ #include #include #include #include "nli.h" SEXP betweenness_R(SEXP mat, SEXP sn, SEXP sm, SEXP smeasure, SEXP sprecomp, SEXP signoreeval, SEXP sgd, SEXP ssigma, SEXP spred) /* Compute betweenness (and some related measures) for the network in mat. If sprecomp==TRUE, then sgd, ssigma, and spred are taken to hold geodesic distances, path counts, and predecessor lists (as returned by geodist_R or geodist_val_r); else, these are computed on the fly (which, BTW, saves memory, though it prohibits reuse). If signoreevals==TRUE, then edge values are not used when computing paths (irrelevant if called with precomputed geodesics). */ { int n,i,j,k,wv,precomp,*npred,ignoreeval,measure,pc=0; double *gd, *sigma,*bet,*delta; element **pred,*w,*v; snaNet *g; SEXP sbet,lp,vp; /*Coerce inputs*/ PROTECT(mat=coerceVector(mat,REALSXP)); pc++; PROTECT(sn=coerceVector(sn,INTSXP)); pc++; PROTECT(sm=coerceVector(sm,INTSXP)); pc++; PROTECT(sprecomp=coerceVector(sprecomp,INTSXP)); pc++; PROTECT(smeasure=coerceVector(smeasure,INTSXP)); pc++; PROTECT(signoreeval=coerceVector(signoreeval,INTSXP)); pc++; n=INTEGER(sn)[0]; precomp=INTEGER(sprecomp)[0]; measure=INTEGER(smeasure)[0]; ignoreeval=INTEGER(signoreeval)[0]; if(precomp){ PROTECT(sgd=coerceVector(sgd,REALSXP)); pc++; PROTECT(ssigma=coerceVector(ssigma,REALSXP)); pc++; } /*Allocate memory*/ PROTECT(sbet=allocVector(REALSXP,n)); pc++; npred=(int *)R_alloc(n,sizeof(int)); pred=(element **)R_alloc(n,sizeof(element *)); gd=(double *)R_alloc(n,sizeof(double)); sigma=(double *)R_alloc(n,sizeof(double)); delta=(double *)R_alloc(n,sizeof(double)); bet=REAL(sbet); /*Set up stuff*/ GetRNGstate(); g=elMatTosnaNet(REAL(mat),INTEGER(sn),INTEGER(sm)); PutRNGstate(); for(i=0;i=0;k--) pred[j]=push(pred[j],REAL(vp)[k]-1.0,NULL); UNPROTECT(1); } }else{ /*Compute on the fly*/ if(ignoreeval) spsp(i,g,gd,sigma,pred,npred,1); else spsp_val(i,g,gd,sigma,pred,npred,1); } /*Accumulate betweenness incremements*/ switch(measure){ case BETSTANDARD: /*"Standard" form betweenness (a la Freeman)*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0+delta[wv]); if(i!=wv) bet[wv]+=delta[wv]; } break; case BETWENDPTS: /*Betweenness including endpoints*/ bet[i]+=npred[i]-1.0; for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0+delta[wv]); if(i!=wv) bet[wv]+=delta[wv]+1.0; } break; case BETPROXIMALSRC: /*Proximal source betweenness*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next){ if((int)(v->val)!=i) bet[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv]; } } break; case BETPROXIMALTAR: /*Proximal target betweenness*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next){ delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0+delta[wv]); if((int)(v->val)==i) bet[wv]+=delta[wv]; } } break; case BETPROXIMALSUM: /*Total proximal betweenness*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next){ delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0+delta[wv]); if((int)(v->val)!=i) bet[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv]; else bet[wv]+=delta[wv]; } } break; case BETLENSCALED: /*Length-scaled betweenness*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0/gd[wv]+delta[wv]); if(i!=wv) bet[wv]+=delta[wv]; } break; case BETLINSCALED: /*Linearly-scaled betweenness*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=sigma[(int)(v->val)]/sigma[wv] * (1.0/gd[wv]+delta[wv]); if(i!=wv) bet[wv]+=gd[wv]*delta[wv]; } break; case BETSTRESS: /*Shimbel's stress centrality (not betweenness!)*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=1.0+delta[wv]; if(i!=wv) bet[wv]+=sigma[wv]*delta[wv]; } break; case BETLOAD: /*Goh's load centrality (must be given transpose graph)*/ for(j=0;jval); pred[i]=pred[i]->next; for(v=pred[wv];v!=NULL;v=v->next) delta[(int)(v->val)]+=delta[wv]/(double)npred[wv]; bet[wv]+=delta[wv]; } break; } } /*Unprotect and return*/ UNPROTECT(pc); return sbet; } void degree_R(double *g, int *pm, int *cmode, int *diag, int *igeval, double *d) /* Compute degree centralities for the graph in g (assumed to be in sna edgelist form). cmode should be 0 for indegree, 1 for outdegree, and 2 for total degree, with diag=1 if the diagonal should be considered, and igeval=1 if edge values should be ignored. Missing edges are omitted in the sum (and corresponding edge counts, where edge values are ignored). The centrality scores themselves are stored in d, which is assumed to be initialized to 0. */ { int m=*pm,i; for(i=0;in,sizeof(double)); for(i=0;i<*n;i++) ev[i]=1.0/sqrt((double)(g->n)); /*Iterate until convergence*/ diff=1.0; j=0; while((sqrt(diff)>(*tol))&&(j<(*maxiter))){ j++; R_CheckUserInterrupt(); /*Calculate unnormalized values*/ for(i=0;i<*n;i++){ ev2[i]=0.0; for(ep=snaFirstEdge(g,i,1);ep!=NULL;ep=ep->next[0]) if((!(*checkna))||((ep->dp!=NULL)&&(!ISNAN(*(double *)(ep->dp))))){ if(*ignoreeval) ev2[i]+=ev[(int)(ep->val)]; else ev2[i]+=(*(double *)(ep->dp))*ev[(int)(ep->val)]; } } /*Obtain norm*/ norm=0.0; for(i=0;i<*n;i++) norm+=ev2[i]*ev2[i]; norm=sqrt(norm); /*Store normalized values*/ diff=0.0; for(i=0;i<*n;i++){ ev2[i]/=norm; diff+=(ev[i]-ev2[i])*(ev[i]-ev2[i]); ev[i]=ev2[i]; } } if(j==(*maxiter)) warning("Maximum iterations exceeded in evcent_R without convergence. This matrix may be pathological - increase maxiter or try eigen().\n"); } void gilschmidt_R(double *mat, int *n, int *m, double *scores, int *normalize) { snaNet *g; double *gd,*sigma; element **pred,*ptr; int i,*npred; /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); PutRNGstate(); /*Initialize various other things*/ gd=(double *)R_alloc(*n,sizeof(double)); sigma=(double *)R_alloc(*n,sizeof(double)); pred=(element **)R_alloc(*n,sizeof(element *)); npred=(int *)R_alloc(*n,sizeof(int)); /*Now, find the unnormalized GS score for each vertex*/ for(i=0;i<*n;i++){ scores[i]=0.0; spsp(i,g,gd,sigma,pred,npred,0); for(ptr=pred[i];ptr!=NULL;ptr=ptr->next) /*Walk those ego can reach*/ if((int)ptr->val!=i) scores[i]+=1.0/gd[(int)ptr->val]; /*Increment as 1/dist*/ if(*normalize) scores[i]/=npred[i]-1.0; } } void stresscent_R(double *g, double *pn, double *stress, double *gd, double *sigma) /* Compute stress centrality for the graph in g. Geodesic distances are assumed to have been stored in gd, and the path counts in sigma (both being nxn matrices). It is also assumed that stress has been initialized to 0. (Note that this is now a legacy routine, and is no longer used -- see betweenness_R above.) */ { long int n,i,j,k; /*Set up stuff*/ n=*pn; /*Cycle through each triad, accumulating paths*/ for(i=0;i=gd[j+i*n]+gd[i+k*n])) stress[i]+=sigma[j+i*n]*sigma[i+k*n]; } } } } sna/src/Rinit.c0000644000176200001440000000564314653004763013073 0ustar liggesusers/* ###################################################################### # # Rinit.c # # copyright (c) 2019, Carter T. Butts # Last Modified 8/01/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains registration routines for R-callable C functions. # ###################################################################### */ #include #include #include #include "cohesion.h" #include "components.h" #include "geodist.h" #include "gli.h" #include "layout.h" #include "likelihood.h" #include "nli.h" #include "paths.h" #include "randomgraph.h" #include "triads.h" #include "utils.h" #define CALLDEF(name, n) {#name,(DL_FUNC) &name, n} /*Call and C method definitions*/ static R_CallMethodDef CallEntries[] = { CALLDEF(bicomponents_R,3), /*cohesion.h*/ CALLDEF(cliques_R,6), CALLDEF(reachability_R,3), /*components.h*/ CALLDEF(geodist_R,6), /*geodist.h*/ CALLDEF(geodist_val_R,6), CALLDEF(betweenness_R,9), /*nli.h*/ CALLDEF(rgbern_R,5), /*randomgraph.h*/ {NULL,NULL,0} }; static R_CMethodDef CEntries[] = { CALLDEF(cutpointsDir_R,4), /*cohesion.h*/ CALLDEF(cutpointsUndir_R,4), CALLDEF(kcores_R,7), CALLDEF(component_dist_R,3), /*components.h*/ CALLDEF(compsizes_R,4), CALLDEF(undirComponents_R,4), CALLDEF(geodist_adj_R,4), /*geodist.h*/ CALLDEF(maxflow_EK_R,5), CALLDEF(brokerage_R,5), /*gli.h*/ CALLDEF(connectedness_R,4), CALLDEF(lubness_con_R,4), CALLDEF(gplot_layout_target_R,14), /*layout.h*/ CALLDEF(gplot_layout_fruchtermanreingold_R,15), CALLDEF(gplot_layout_fruchtermanreingold_old_R,10), CALLDEF(gplot_layout_kamadakawai_R,9), CALLDEF(gplot3d_layout_fruchtermanreingold_R,11), CALLDEF(gplot3d_layout_kamadakawai_R,10), CALLDEF(bn_dyadstats_R,3), /*likelihood.h*/ CALLDEF(bn_triadstats_R,3), CALLDEF(bn_lpl_dyad_R,7), CALLDEF(bn_lpl_triad_R,8), CALLDEF(bn_ptriad_R,5), CALLDEF(degree_R,6), /*nli.h*/ CALLDEF(evcent_R,8), CALLDEF(stresscent_R,5), CALLDEF(gilschmidt_R,5), CALLDEF(cycleCensus_R,9), /*paths.h*/ CALLDEF(pathCensus_R,11), CALLDEF(bn_cftp_R,8), /*randomgraph.h*/ CALLDEF(bn_mcmc_R,13), CALLDEF(udrewire_R,4), CALLDEF(wsrewire_R,5), CALLDEF(transitivity_R,6), /*triads.h*/ CALLDEF(triad_census_R,6), CALLDEF(triad_classify_R,3), CALLDEF(aggarray3d_R,5), /*utils.h*/ CALLDEF(dyadcode_R,4), CALLDEF(logadd_R,3), CALLDEF(logsub_R,4), {NULL,NULL,0} }; void R_init_sna(DllInfo *dll) { R_registerRoutines(dll,CEntries,CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } sna/src/nli.h0000644000176200001440000000430614533477336012577 0ustar liggesusers/* ###################################################################### # # nli.h # # copyright (c) 2004, Carter T. Butts # Last Modified 3/29/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for nli.c. # ###################################################################### */ #ifndef NLI_H #define NLI_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" #include "geodist.h" /*Definitions for various measures to be computed by betweenness_R (mostly based on Brandes (2008)); note that some are not forms of betweenness, but can be calculated using that routine.*/ #define BETSTANDARD 0 /*"Standard" form betweenness (a la Freeman)*/ #define BETWENDPTS 1 /*Betweenness including endpoints*/ #define BETPROXIMALSRC 2 /*Proximal source betweenness*/ #define BETPROXIMALTAR 3 /*Proximal target betweenness*/ #define BETPROXIMALSUM 4 /*Total proximal betweenness*/ #define BETLENSCALED 5 /*Length-scaled betweenness*/ #define BETLINSCALED 6 /*Linearly-scaled betweenness*/ #define BETSTRESS 7 /*Shimbel's stress centrality (not betweenness!)*/ #define BETLOAD 8/*Goh's load centrality (must be given transpose graph)*/ /*INTERNAL ROUTINES---------------------------------------------------------*/ /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP betweenness_R(SEXP mat, SEXP sn, SEXP sm, SEXP smeasure, SEXP sprecomp, SEXP signoreevals, SEXP sgd, SEXP ssigma, SEXP spred); void degree_R(double *g, int *pm, int *cmode, int *diag, int *igeval, double *d); void evcent_R(double *mat, int *n, int *m, double *ev, double *tol, int *maxiter, int *checkna, int *ignoreeval); void stresscent_R(double *g, double *pn, double *stress, double *gd, double *sigma); void gilschmidt_R(double *mat, int *n, int *m, double *scores, int *normalize); #endif sna/src/randomgraph.h0000644000176200001440000000317614653000337014305 0ustar liggesusers/* ###################################################################### # # randomgraph.h # # copyright (c) 2004, Carter T. Butts # Last Modified 8/01/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for randomgraph.c. # ###################################################################### */ #ifndef RANDOMGRAPH_H #define RANDOMGRAPH_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include "utils.h" /*Homogeneity classes for rgbern*/ #define BERNHOM 0 /*Homogeneous throughout the adjacency matrix*/ #define BERNROW 1 /*Homogeneous within rows*/ #define BERNCOL 2 /*Homogeneous within columns*/ #define BERNHET 3 /*Heteogeneous*/ /*INTERNAL ROUTINES---------------------------------------------------------*/ /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void bn_cftp_R(int *g, int *pn, double *pi, double *sigma, double *rho, double *d, int *pmaxiter, int *sibdichot); void bn_mcmc_R(int *g, double *pn, double *pdraws, double *pburn, int *pthin, double *pi, double *sigma, double *rho, double *d, double *delta, double *epsilon, int *sibdichot, double *maxedge); SEXP rgbern_R(SEXP sn, SEXP stp, SEXP sdirected, SEXP sloops, SEXP spmode); void udrewire_R(double *g, double *pn, double *pnv, double *pp); void wsrewire_R(double *gi, double *go, double *pn, double *pnv, double *pp); #endif sna/src/paths.c0000644000176200001440000004467614667215410013134 0ustar liggesusers/* ###################################################################### # # paths.c # # copyright (c) 2007, Carter T. Butts # Last Modified 9/7/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to cycle and path counting. # ###################################################################### */ #include #include #include #include "utils.h" #include "paths.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ void edgewisePathRecurse(snaNet *g, int src, int dest, int curnode, int *availnodes, int availcount, int *usednodes, int curlen, double *count, double *cpcount, double *dpcount, int maxlen, int directed, int byvertex, int copaths, int dyadpaths) /*Recursively count the paths from src to dest. (This is an adaptation of the routine I wrote for statnet.) count should be vector of path counts (starting with length 1) if !byvertex, or else a matrix of dimension (maxlen-1)x(n+1) whose first column contains aggregate counts and i+1th column contains counts for vertex i. If copaths==1, cpcount should contain an nxn matrix containing path co-membership counts. If copaths=2, cpcount should contain a (maxlen-1)xnxn array containing path co-membership counts at each length. This is ignored if copaths==0. (Odd note: if this is being used to construct a path census, rather than a cycle census, maxlen should be one greater than the true maximum length. It looks wrong, but it isn't. All of the maxlen-1 stuff in here is also correct, even though (e.g., for dyad paths) it may appear otherwise.)*/ { int *newavail,i,j,k,newavailcount,*newused,n; /*Rprintf("\t\t\tRecursion: src=%d, dest=%d, curnode=%d, curlen=%d, availcount=%d\n",src,dest, curnode,curlen,availcount);*/ n=g->n; /*Rprintf("N=%d\n",n);*/ /*If we've found a path to the destination, increment the census vector*/ if(directed||(curnode0)&&(curlen1){ /*Remove the current node from the available list*/ /*Rprintf("\t\t\tRemoving %d from available node list (availcount=%d)\n", curnode,availcount);*/ if((newavail=(int *)R_Calloc((size_t)(availcount-1),int))==NULL){ Rprintf("Unable to allocate %ld bytes for available node list in edgewisePathRecurse. Trying to terminate recursion gracefully, but your path count is probably wrong.\n",(long int)(sizeof(int)*(availcount-1))); return; } j=0; for(i=0;in; usednodes=NULL; /*First, check for a 2-cycle (but only if directed)*/ /*Rprintf("\t\tChecking for (%d,%d) edge\n",dest,src);*/ if(directed&&snaIsAdjacent(dest,src,g,2)){ count[0]++; if(byvertex){ count[(1+src)*(maxlen-1)]++; count[(1+dest)*(maxlen-1)]++; } if(cocycles==1){ cccount[src+dest*n]++; cccount[dest+src*n]++; cccount[src+src*n]++; cccount[dest+dest*n]++; } if(cocycles==2){ cccount[src*(maxlen-1)+dest*(maxlen-1)*n]++; cccount[dest*(maxlen-1)+src*(maxlen-1)*n]++; cccount[src*(maxlen-1)+src*(maxlen-1)*n]++; cccount[dest*(maxlen-1)+dest*(maxlen-1)*n]++; } } if(n==2) return; /*Failsafe for graphs of order 2*/ /*Perform the recursive path count*/ if((availnodes=(int *)R_Calloc((size_t)(n-2),int))==NULL){ Rprintf("Unable to allocate %ld bytes for available node list in edgewiseCycleCensus. Exiting.\n",(long int)(sizeof(int)*(n-2))); return; } j=0; /*Initialize the list of available nodes*/ for(i=0;in; usednodes=NULL; if(n<2) return; /*Failsafe for graphs of order 2*/ /*Check for a 1-path (i.e., edge)*/ /*Rprintf("\t\tChecking for (%d,%d) edge\n",src,dest);*/ if(snaIsAdjacent(src,dest,g,2)||((!directed)&&snaIsAdjacent(dest,src,g,2))){ count[0]++; if(byvertex){ count[(1+src)*maxlen]++; count[(1+dest)*maxlen]++; } if(copaths==1){ cpcount[src+dest*n]++; cpcount[dest+src*n]++; cpcount[src+src*n]++; cpcount[dest+dest*n]++; } if(copaths==2){ cpcount[src*maxlen+dest*maxlen*n]++; cpcount[dest*maxlen+src*maxlen*n]++; cpcount[src*maxlen+src*maxlen*n]++; cpcount[dest*maxlen+dest*maxlen*n]++; } if(dyadpaths==1){ /*Update dyadic path counts*/ dpcount[src+dest*n]++; if(!directed) dpcount[dest+src*n]++; } if(dyadpaths==2){ /*Update dyadic path counts using len*/ dpcount[src*maxlen+dest*maxlen*n]++; if(!directed) dpcount[dest*maxlen+src*maxlen*n]++; } } /*Perform the recursive path count*/ if((availnodes=(int *)R_Calloc((size_t)(n-2),int))==NULL){ Rprintf("Unable to allocate %ld bytes for available node list in dyadPathCensus. Exiting.\n",(long int)sizeof(int)*(n-2)); return; } j=0; /*Initialize the list of available nodes*/ for(i=0;in=(*pn); ng->indeg=(int *)R_alloc(n,sizeof(int)); ng->outdeg=(int *)R_alloc(n,sizeof(int)); ng->iel=(slelement **)R_alloc(n,sizeof(slelement *)); ng->oel=(slelement **)R_alloc(n,sizeof(slelement *)); /*Initialize the graph*/ for(i=0;iindeg[i]=0; ng->outdeg[i]=0; ng->iel[i]=NULL; ng->oel[i]=NULL; } /*Walk the graph, adding edges and accumulating cycles*/ /*Rprintf("Building graph/accumulating cycles\n\tn=%d,%d\n",n,ng->n);*/ for(i=0;iiel[c]=slistInsert(ng->iel[c],(double)r,(void *)dval); ng->indeg[c]++; dval=(double *)R_alloc(1,sizeof(double)); /*Create oel element*/ dval[0]=(double)g[i+2*m]; ng->oel[r]=slistInsert(ng->oel[r],(double)c,(void *)dval); ng->outdeg[r]++; if(!(*pdirected)){ dval=(double *)R_alloc(1,sizeof(double)); /*Create iel element*/ dval[0]=(double)g[i+2*m]; ng->iel[r]=slistInsert(ng->iel[r],(double)c,(void *)dval); ng->indeg[r]++; dval=(double *)R_alloc(1,sizeof(double)); /*Create oel element*/ dval[0]=(double)g[i+2*m]; ng->oel[c]=slistInsert(ng->oel[c],(double)r,(void *)dval); ng->outdeg[c]++; } } PutRNGstate(); } void pathCensus_R(double *g, int *pn, int *pm, double *count, double *cpcount, double *dpcount, int *pmaxlen, int *pdirected, int *pbyvertex, int *pcopaths, int *pdyadpaths) /*Conduct a census of paths in g, out to length maxlen. The byvertex and copaths flags indicate whether path counts should be broken down by participating vertex, and whether path co-membership counts should be returned (respectively). In either case, count and pccount must be structured per count and pccount in edgewisePathRecurse.*/ { int i,j,n; snaNet *ng; /*Create the new graph object*/ n=(*pn); GetRNGstate(); ng=elMatTosnaNet(g,pn,pm); /*Walk the graph, counting paths associated with each pair*/ for(i=0;i # Last Modified 07/19/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the identification of # components. # ###################################################################### */ #include #include #include #include "components.h" slelement *BFS(snaNet *g, int *n, int v, int transpose) /*This is a boring old BFS, included as a utility. It starts with vertex v, and proceeds forward (transpose=0) or backward (transpose=1), building a skip list of reached vertices. A pointer to the resulting list is returned.*/ { int i; char *vis; element *tovis=NULL,cur; slelement *reach=NULL,*ep; /*Initialize visit list*/ vis=(char *)R_alloc(*n,sizeof(char)); for(i=0;i<*n;i++) vis[i]=0; /*Run the BFS*/ tovis=push(tovis,(double)v,NULL); vis[v]=1; while(tovis!=NULL){ /*Pop the node to visit, and add to list*/ cur=pop(tovis); tovis=cur.next; reach=slistInsert(reach,cur.val,NULL); /*Add the neighbors of this node, if not already marked*/ if(!transpose){ for(ep=snaFirstEdge(g,(int)(cur.val),1);ep!=NULL;ep=ep->next[0]) if(!vis[(int)(ep->val)]){ tovis=push(tovis,ep->val,NULL); vis[(int)(ep->val)]++; } }else{ for(ep=snaFirstEdge(g,(int)(cur.val),0);ep!=NULL;ep=ep->next[0]) if(!vis[(int)(ep->val)]){ tovis=push(tovis,ep->val,NULL); vis[(int)(ep->val)]++; } } } /*Return the reach list. R will deallocate other memory (eventually).*/ return reach; } element *BFS_unord(snaNet *g, int *n, int v, int transpose) /*This is a BFS utility, identical to BFS except that the return value is different (and not placed by vertex order); this is somewhat faster, because we save the O(log(n)) insertion cost of a skip list, and have less overhead. It starts with vertex v, and proceeds forward (transpose=0) or backward (transpose=1), building a stack of reached vertices. A pointer to the resulting list is returned. Note that the format of this stack is distinctive. The head element that is returned has val equal to the number of list elements (i.e., not including head), and next pointing to the first element (if any). Because they are placed as a stack from the BFS, vertices do actually have an order (it's reverse order of visit), but we call this "unordered" to distinguish from the vertex sorted order in BFS(). If you don't care about the order, this is the routine to use. */ { int i; char *vis; element *tovis=NULL,cur,*reach; slelement *ep; /*Initialize visit list and the reach list*/ reach=(element *)R_alloc(1,sizeof(element)); /*Head node*/ reach->next=NULL; /*First neighbor*/ reach->val=0.0; /*List length*/ vis=(char *)R_alloc(*n,sizeof(char)); for(i=0;i<*n;i++) vis[i]=0; /*Run the BFS*/ tovis=push(tovis,(double)v,NULL); vis[v]=1; while(tovis!=NULL){ /*Pop the node to visit, and add to list*/ cur=pop(tovis); tovis=cur.next; reach->next=push(reach->next,cur.val,NULL); /*Push to the reach stack*/ (reach->val)++; /*Increment counter*/ /*Add the neighbors of this node, if not already marked*/ if(!transpose){ for(ep=snaFirstEdge(g,(int)(cur.val),1);ep!=NULL;ep=ep->next[0]) if(!vis[(int)(ep->val)]){ tovis=push(tovis,ep->val,NULL); vis[(int)(ep->val)]++; } }else{ for(ep=snaFirstEdge(g,(int)(cur.val),0);ep!=NULL;ep=ep->next[0]) if(!vis[(int)(ep->val)]){ tovis=push(tovis,ep->val,NULL); vis[(int)(ep->val)]++; } } } /*Return the reach list. R will deallocate other memory (eventually).*/ return reach; } int numStrongComponents(snaNet *g, int *n) /*Return the number of strong components in g.*/ { int *comp,i,ccount=*n; /*Get the components*/ comp=strongComponents(g,n); /*Count 'em (should be equal to n-min component number)*/ for(i=0;i<*n;i++) ccount=MIN(ccount,comp[i]); return *n-ccount; } slelement *strongComponentByVertex(snaNet *g, int *n, int v) /*Use a lame BFS algorithm to return the maximal strong component to which the specified vertex belongs (as an slist). This is placed here as a utility, rather than as an R-callable routine.*/ { slelement *olist=NULL,*ilist=NULL,*comp=NULL; /*Get out/in lists*/ olist=BFS(g,n,v,0); ilist=BFS(g,n,v,1); /*Find the intersection*/ olist=olist->next[0]; ilist=ilist->next[0]; while((olist!=NULL)&&(ilist!=NULL)){ if(olist->val==ilist->val){ comp=slistInsert(comp,olist->val,NULL); ilist=ilist->next[0]; olist=olist->next[0]; }else{ if(olist->valval){ olist=olist->next[0]; }else{ ilist=ilist->next[0]; } } } /*Return the result*/ return comp; } int *strongComponents(snaNet *g, int *n) /*This function uses a variant of Tarjan's DFS algorithm published in a technical report by David J. Pearce to find the strongly connected components of g (which are returned via an index vector). Pearce's algorithm has the same running time as Tarjan's, but is (very) slightly more space efficient.*/ { int i,*index,*ccount,*rindex; element *dfs; /*Initialize everything*/ dfs=(element *)R_alloc(1,sizeof(element)); rindex=(int *)R_alloc(*n,sizeof(int)); index=(int *)R_alloc(1,sizeof(int)); ccount=(int *)R_alloc(1,sizeof(int)); for(i=0;i<*n;i++) rindex[i]=0; ccount[0]=*n-1; index[0]=1; dfs->next=NULL; /*Find the components*/ for(i=0;i<*n;i++) if(rindex[i]==0) strongComponentsRecurse(g,n,i,rindex,index,ccount,dfs); // for(i=0;i<*n;i++) // Rprintf("%d ",rindex[i]); // Rprintf("\n"); /*Return the result*/ return rindex; } void strongComponentsRecurse(snaNet *g, int *n, int v, int *rindex, int *index, int *ccount, element *dfs) { char root=1; element w; slelement *ep; /*Set index for v, and increment*/ rindex[v]=*index; (*index)++; /*Visit v's unvisited out-neighbors*/ for(ep=snaFirstEdge(g,v,1);ep!=NULL;ep=ep->next[0]){ if(rindex[(int)(ep->val)]==0) strongComponentsRecurse(g,n,(int)(ep->val),rindex,index,ccount,dfs); if(rindex[(int)(ep->val)]val]; root=0; } } /*If v is the root of its tree, pop its subtree and mark as one component*/ if(root){ (*index)--; while((dfs->next!=NULL)&&(rindex[v]<=rindex[(int)(dfs->next->val)])){ w=pop(dfs->next); dfs->next=w.next; rindex[(int)(w.val)]=*ccount; (*index)--; } rindex[v]=*ccount; (*ccount)--; }else /*Otherwise, add v to the stack*/ dfs->next=push(dfs->next,(double)v,NULL); } int *undirComponents(snaNet *g) /*Returns the components of an undirected graph g as a vector of integers. The vector length is g->n+1, with the first element being the number of components. (Yes, this is slightly different from strongComponents, above, and the two should be harmonized eventually.)*/ { int i,*memb; /*Initialize*/ memb=(int *)R_alloc(g->n+1,sizeof(int)); for(i=0;in+1;i++) memb[i]=0; /*Perform a DFS to find the components*/ for(i=0;in;i++) if(memb[i+1]==0){ memb[0]++; undirComponentsRecurse(g,i,memb); } return memb; } void undirComponentsRecurse(snaNet *g,int v,int *memb) /*Recursive computation for components of an undirected graph (via DFS). v is the current vertex, and memb is a membership vector with the i+1th element corresponding to the ith vertex (the first element contains the current number of components). We assume that we are being called on the "current" component, and thus memb[0] is taken as the assignment for all reachable vertices; memb[i]==0 is used to indicate an unreached vertex.*/ { slelement *sp; memb[v+1]=memb[0]; /*Label the current vertex*/ /*If any neighbors, recurse accordingly*/ if(g->outdeg[v]>0) for(sp=g->oel[v]->next[0];sp!=NULL;sp=sp->next[0]) if(memb[(int)(sp->val)+1]==0) undirComponentsRecurse(g,(int)(sp->val),memb); } void undirComponentsNoRecurse(snaNet *g, int *memb) /*Stores the components of an undirected graph g as a vector of integers. The vector length is g->n+1, with the first element being the number of components. This is equivalent to undirComponents, but uses a non-recursive algorithm. The recursive version is more elegant, but runs into stack limit issues on large graphs.*/ { int i; element *tovis=NULL,*cur; slelement *ep; void *vmax; /*Initialize*/ for(i=0;in+1;i++) memb[i]=0; /*Perform a DFS to find the components; memb[i+1] is ith membership (1,...)*/ for(i=0;in;i++) if(memb[i+1]==0){ /*If we've not seen vertex i, start tracin'*/ vmax=vmaxget(); /*Record the current mem stack state*/ memb[0]++; /*Increment the component count*/ tovis=push(NULL,(double)i,NULL); /*Push to tovis, start the BFS*/ memb[i+1]=memb[0]; while(tovis!=NULL){ /*Pop the node to visit*/ cur=tovis; tovis=cur->next; /*Add unvisited neighbors to our list, and mark membership*/ for(ep=snaFirstEdge(g,(int)(cur->val),1);ep!=NULL;ep=ep->next[0]) if(!memb[(int)(ep->val)+1]){ tovis=push(tovis,ep->val,NULL); memb[(int)(ep->val)+1]=memb[0]; } } /*Free the stack*/ vmaxset(vmax); } } /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void component_dist_R(double *g, double *pn, double *memb) /* Determine component memberships in g. The memberships are stored in memb, which must be a zero-initialized vector of length *pn. */ { char *visited; long int n,v,nod,i,s1count; double comp=0.0; /*Set up stuff*/ n=*pn; /*Allocate memory for visited list*/ visited=(char *)R_alloc(n,sizeof(char)); /*Cycle through each node, performing a BFS*/ for(v=0;v0*/ visited[nod]=3; /*Mark as visited*/ s1count--; memb[nod]=comp; /*Set membership to comp*/ for(i=v+1;ival); /*Increment reachability graph edge count*/ /*Rprintf("Node %d, Reach %d, Total %d\n",i+1,(int)(rl[i]->val),rm);*/ } /*Write the reachability edge list*/ PROTECT(srg=allocMatrix(REALSXP,rm,3)); pc++; rg=REAL(srg); ctr=0; for(i=0;inext;p!=NULL;p=p->next){ rg[ctr]=(double)(i+1); /*Remember to use R numbering!*/ rg[ctr+rm]=1.0+p->val; rg[ctr+2*rm]=1.0; ctr++; } } /*Add n attribute to make it an sna edgelist*/ san = PROTECT(allocVector(REALSXP, 1)); pc++; REAL(san)[0] = n; setAttrib(srg, install("n"), san); /*Unprotect and return*/ UNPROTECT(pc); return srg; } void undirComponents_R(double *mat, int *n, int *m, int *memb) /*Find the components of the undirected graph contained in mat (with n vertices and m edges). The result is stored in memb, which should be a vector of length n+1; on return, the first entry will give the number of components, and the second will give the component memberships. This version is non-recursive, minimizing annoying R-related issues on large graphs. */ { snaNet *g; /*Workaround: disable R's stack checking mechanism, since it do be stupid R_CStackLimit = (uintptr_t)-1;*/ /*Initialize sna internal network*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); PutRNGstate(); /*Find components and tabulate sizes*/ undirComponentsNoRecurse(g,memb); } sna/src/randomgraph.c0000644000176200001440000005441614667250437014320 0ustar liggesusers/* ###################################################################### # # randomgraph.c # # copyright (c) 2004, Carter T. Butts # Last Modified 9/07/24 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the generation of random # graphs. # ###################################################################### */ #include #include #include #include #include "randomgraph.h" void bn_cftp_R(int *g, int *pn, double *pi, double *sigma, double *rho, double *d, int *pmaxiter, int *sibdichot) { int *lparents,*uparents,lec,uec; double *lne,lnpar,lnsib,lndblr,ep,*coins,*ctemp; int ostate,*lb,*ub,converged,mismatch,t,maxiter,n,i,j,k,x,*r,*c,*temp; /*Initialize various things*/ n=(int)*pn; GetRNGstate(); lparents=(int *)R_alloc(n*n,sizeof(int)); uparents=(int *)R_alloc(n*n,sizeof(int)); lb=(int *)R_alloc(n*n,sizeof(int)); ub=(int *)R_alloc(n*n,sizeof(int)); lne=(double *)R_alloc(n*n,sizeof(double)); for(i=0;i0)*lnsib+ lb[k+j*n]*(lparents[j+k*n]>0)*lndblr); else ep=1.0-exp(lne[j+k*n]+lb[k+j*n]*lnpar+lparents[j+k*n]*lnsib+ lb[k+j*n]*lparents[j+k*n]*lndblr); if(coins[t+i]<=ep){ lb[j+k*n]=1; /*Set the edge*/ /*If something has changed update the parent count*/ if(ostate==0){ /*Rprintf("\tAdded edge update\n");*/ for(x=0;x0)*lnsib+ ub[k+j*n]*(uparents[j+k*n]>0)*lndblr); else ep=1.0-exp(lne[j+k*n]+ub[k+j*n]*lnpar+uparents[j+k*n]*lnsib+ ub[k+j*n]*uparents[j+k*n]*lndblr); if(coins[t+i]<=ep){ ub[j+k*n]=1; /*Set the edge*/ /*If something has changed update the parent count*/ if(ostate==0){ /*Rprintf("\tAdded edge update\n");*/ for(x=0;x0)*lnsib+ g[k+j*n]*(lparents[j+k*n]>0)*lndblr); else ep=1.0-exp(lne[j+k*n]+g[k+j*n]*lnpar+lparents[j+k*n]*lnsib+ g[k+j*n]*lparents[j+k*n]*lndblr); if(coins[t+i]<=ep){ g[j+k*n]=1; /*Set the edge*/ /*If something has changed update the parent count*/ if(ostate==0){ /*Rprintf("\tAdded edge update\n");*/ for(x=0;x=maxiter){ warning("Maximum CFTP iterations exceeded; returning missing values. (Your sample may also be biased.)\n"); for(i=0;i0)*lnsib+ g[i+k*draws+j*n*draws]*(parents[j+k*n]>0)*lndblr); else ep=1.0-exp(lne[j+k*n]+g[i+k*draws+j*n*draws]*lnpar+parents[j+k*n]*lnsib+ g[i+k*draws+j*n*draws]*parents[j+k*n]*lndblr); ep*=exp(odeg[j]*lnsat+lni[j+k*n]); if(runif(0.0,1.0)<=ep){ ec+=1.0-g[i+j*draws+k*n*draws]; /*Increment the edge count*/ g[i+j*draws+k*n*draws]=1; /*Set the edge*/ /*If something has changed update the parent count and outdegree count*/ if(ostate==0){ odeg[j]++; /*Rprintf("\tAdded edge update\n");*/ for(x=0;xn-2) Rprintf("Parent overflow: iter=%ld j=%ld k=%ld x=%ld",i,j,k,x); */ } } }else{ ec-=g[i+j*draws+k*n*draws]; /*Decrement the edge count*/ g[i+j*draws+k*n*draws]=0; /*Unset the edge*/ /*If something has changed update the parent and outdegree count*/ if(ostate==1){ odeg[j]--; /*Rprintf("\tDeleted edge update\n");*/ for(x=0;x *maxedge){ /*Stop if density guard is tripped*/ stopflag=1; *maxedge = -1.0; /*Set to negative to show the trip state*/ } /*Burn-in check*/ if(bcn-2) Rprintf("Parent overflow: iter=%ld j=%ld k=%ld x=%ld",i,j,k,x); */ } } }else{ g[i+j*draws+k*n*draws]=0; /*Unset the edge*/ /*If something has changed update the parent count*/ if(g[i-1+j*draws+k*n*draws]==1){ /*Rprintf("\tDeleted edge update\n");*/ for(x=0;x=c); } }else{ if(loops){ c=n-floor(sqrt(n*(n+1.0)-2.0*w-1.75)-0.5)-1.0; r=w-c*(n-1.0)+c*(c-1.0)/2.0; }else{ c=n-2.0-floor(sqrt(n*(n-1.0)-2.0*w-1.75)-0.5); r=w+c*((c+1.0)/2.0-n+1.0)+1.0; } } el=enqueue(el,r+c*n,NULL); m++; if((!directed)&&(r!=c)){ el=enqueue(el,c+r*n,NULL); m++; } } } break; case BERNROW: /*For each row, use a waiting time scheme*/ for(i=0;i=(double)i))*n,NULL); m++; if((!directed)&&((!loops)||(w!=(double)i))){ el=enqueue(el,(w+(!loops)*(w>=(double)i))+i*n,NULL); m++; } } } } break; case BERNCOL: for(i=0;i=(double)i))+i*n,NULL); m++; if((!directed)&&((!loops)||(w!=(double)i))){ el=enqueue(el,i+(w+(!loops)*(w>=(double)i))*n,NULL); m++; } } } } break; case BERNHET: /*No shortcuts, just draw directly*/ for(i=0;inext){ c=floor((ep->val)/(double)n); r=fmod(ep->val,(double)n); g[i]=r+1; g[i+m]=c+1; g[i+2*m]=1.0; i++; } PROTECT(sn2=allocVector(INTSXP,1)); pc++; /*Set graph size attribute*/ INTEGER(sn2)[0]=n; setAttrib(sg,install("n"), sn2); PROTECT(dim=allocVector(INTSXP, 2)); pc++; /*Set dimension attribute*/ INTEGER(dim)[0] = m; INTEGER(dim)[1] = 3; setAttrib(sg,R_DimSymbol,dim); /*Unprotect and return*/ PutRNGstate(); UNPROTECT(pc); return sg; } void udrewire_R(double *g, double *pn, double *pnv, double *pp) /*Perform a uniform rewiring process on the adjacency array pointed to by *g. It is assumed that g contains a *pn x *pnv *pnv array, whose dyads are rewired (symmetrically) with uniform probability *pp.*/ { long int n,nv,i,j,k,h,t; double p,tempht,tempth; /*Take care of preliminaries*/ n=(long int)*pn; nv=(long int)*pnv; p=*pp; GetRNGstate(); /*Rewire the array*/ for(i=0;i # Last Modified 6/25/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the computation of graph # level indices (GLIs). # ###################################################################### */ #include #include #include #include "gli.h" void brokerage_R(double *g, int *pn, int *pm, int *cl, double *brok) /*Calculate Gould-Fernandez brokerage scores for the vertices of g, based on the vertex class vector cl. Scores are recorded in a *pn x 5 matrix, brok, whose columns are (in order) counts of coordinator, representative, gatekeeper, itinerant, and liason broker roles for each vertex.*/ { int n,i,j,k; slelement *ep,*ep2; snaNet *net; /*Set things up*/ n=*pn; for(i=0;inext[0]) /*ego->alter*/ if(ep->val!=(double)i){ for(ep2=snaFirstEdge(net,(int)(ep->val),1);ep2!=NULL;ep2=ep2->next[0]) /*alt->alt*/ if((ep2->val!=(double)i)&&(ep2->val!=ep->val)){ /*Found 2-path?*/ if(!snaIsAdjacent(i,(int)(ep2->val),net,0)){ /*Found broker?*/ j=(int)(ep->val); k=(int)(ep2->val); /*Classify by type*/ if(cl[j]==cl[i]){ if(cl[j]==cl[k]) brok[j]++; /*Type 0: Within-group (wI) [i j k]*/ else brok[j+2*n]++; /*Type 2: Representative (bIO) [i j] [k]*/ }else if(cl[j]==cl[k]){ brok[j+3*n]++; /*Type 3: Gatekeeping (bOI) [i] [j k]*/ }else if(cl[i]==cl[k]){ brok[j+n]++; /*Type 2: Itinerant (WO) [j] [i k]*/ }else brok[j+4*n]++; /*Type 4: Liason (bO) [i] [j] [k]*/ } } } } } void connectedness_R(double *mat, int *n, int *m, double *con) /*Compute Krackhardt's connectedness for the graph in mat (which must be pre- symmetrized using mode=="weak", since the measure is semipath based).*/ { snaNet *g; int i,*memb,*csize; /*Calculate the weak components of g*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); PutRNGstate(); memb=undirComponents(g); /*Tabulate the component sizes*/ csize=(int *)R_alloc(memb[0],sizeof(int)); for(i=0;i2){ /*No violations unless n>2, given weak connectivity*/ for(i=0;i # Last Modified 6/25/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for gli.c. # ###################################################################### */ #ifndef GLI_H #define GLI_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include "utils.h" #include "components.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void brokerage_R(double *g, int *pn, int *pm, int *cl, double *brok); void connectedness_R(double *mat, int *n, int *m, double *con); void lubness_con_R(double *g, double *pn, int *r, double *viol); #endif sna/src/likelihood.h0000644000176200001440000000443014533477342014133 0ustar liggesusers/* ###################################################################### # # likelihood.h # # copyright (c) 2004, Carter T. Butts # Last Modified 3/10/05 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for likelihood.c. # ###################################################################### */ #ifndef LIKELIHOOD_H #define LIKELIHOOD_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include /*INTERNAL ROUTINES---------------------------------------------------------*/ double bn_lpka(long int k,double pi, double sigma, double rho, double d); double bn_lpkm(long int k,double pi, double sigma, double rho, double d); double bn_lpkn(long int k,double pi, double sigma, double rho, double d); double bn_lpt(int xy, int yx, int yz, int zy, int xz, int zx, long int kxy, long int kyz, long int kxz, double pi, double sigma, double rho, double d); double bn_lpt_M(long int m,double pi,double sigma,double rho,double d); double bn_lpt_a(long int m,double pi,double sigma,double rho,double d); double bn_lpt_N(long int m,double pi,double sigma,double rho,double d); double bn_lpt_Mp1(long int m,double pi,double sigma,double rho,double d); double bn_lpt_ap1(long int m,double pi,double sigma,double rho,double d); double bn_lpt_Np1(long int m,double pi,double sigma,double rho,double d); double bn_lpt_M1(double pi,double sigma,double rho,double d); double bn_lpt_a1(double pi,double sigma,double rho,double d); double bn_lpt_N1(double pi,double sigma,double rho,double d); double bn_lpt_Sr(double pi,double sigma,double rho,double d); double bn_lpt_1mSr(double pi,double sigma,double rho,double d); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void bn_dyadstats_R(int *g, double *pn, double *stats); void bn_triadstats_R(int *g, double *pn, double *stats); void bn_lpl_dyad_R(double *stats, double *psr, double *pi, double *sigma, double *rho, double *d, double *lpl); void bn_lpl_triad_R(int *g, double *stats, double *pn, double *pi, double *sigma, double *rho, double *d, double *lpl); void bn_ptriad_R(double *pi, double *sigma, double *rho, double *d, double *pt); #endif sna/src/layout.h0000644000176200001440000000461614533477351013333 0ustar liggesusers/* ###################################################################### # # layout.h # # copyright (c) 2004, Carter T. Butts # Last Modified 11/21/10 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for layout.c. # ###################################################################### */ #ifndef LAYOUT_H #define LAYOUT_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" /*Macro: is a within the [b,c] interval?*/ #define ININT(a,b,c) ((a-b)*(a-c)<=0.0) /*INTERNAL ROUTINES---------------------------------------------------------*/ double angdist(double a, double b, double ilen); double poldist(double ra,double ta,double rb,double tb); double pollinedist(double ra,double ta,double rb,double tb, double rc, double tc); int poledgecross(double ra, double ta, double rb, double tb, double rc, double tc, double rd, double td); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void gplot_layout_target_R(int *d, double *pn, int *pniter, double *elen, double *radii, int *core, double *pdisconst, double *pcrossconst, double *prepconst, double *pminpdis, double *pinitemp, double *pcoolexp, double *pmaxdelta, double *theta); void gplot_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y); void gplot_layout_fruchtermanreingold_old_R(double *d, int *pn, int *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, double *x, double *y); /*Deprecated code, to be removed*/ void gplot_layout_kamadakawai_R(int *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y); void gplot3d_layout_fruchtermanreingold_R(double *d, int *pn, int *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, double *x, double *y, double *z); void gplot3d_layout_kamadakawai_R(double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y, double *z); #endif sna/src/geodist.h0000644000176200001440000000250214533477372013447 0ustar liggesusers/* ###################################################################### # # geodist.h # # copyright (c) 2004, Carter T. Butts # Last Modified 4/26/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for geodist.c. # ###################################################################### */ #ifndef GEODIST_H #define GEODIST_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ void spsp(int ego, snaNet *g, double *gd, double *sigma, element **pred, int *npred, int checkna); void spsp_val(int ego, snaNet *g, double *gd, double *sigma, element **pred, int *npred, int checkna); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void geodist_adj_R(double *g, double *pn, double *gd, double *sigma); SEXP geodist_R(SEXP mat, SEXP sn, SEXP m, SEXP scheckna, SEXP scalcsig, SEXP scalcpred); SEXP geodist_val_R(SEXP mat, SEXP sn, SEXP sm, SEXP scheckna, SEXP scalcsig, SEXP scalcpred); void maxflow_EK_R(double *g,int *pn,int *psource,int *psink,double *flow); #endif sna/src/triads.h0000644000176200001440000000215114533477315013274 0ustar liggesusers/* ###################################################################### # # triads.h # # copyright (c) 2004, Carter T. Butts # Last Modified 6/26/11 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for triads.c. # ###################################################################### */ #ifndef TRIADS_H #define TRIADS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include "utils.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ int triad_classify(int *g, int gn, int i, int j, int k, int gm); int triad_classify_el(snaNet *g, int i, int j, int k, int gm, int checkmissing); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void transitivity_R(double *mat, int *n, int *m, double *t, int *meas, int *checkna); void triad_census_R(double *g, int *n, int *m, double *t, int *gm, int *checkna); void triad_classify_R(int *g, int *tt, int *gm); #endif sna/src/utils.h0000644000176200001440000001330413115721214013131 0ustar liggesusers/* ###################################################################### # # utils.h # # copyright (c) 2006, Carter T. Butts # Last Modified 06/06/17 # Licensed under the GNU General Public License version 2 (June, 1991) or # later. # Portions taken from the NetStat library by Carter T. Butts (2002) # (self-licensed under GPL) # # Part of the R/sna package # # This file contains headers for utils.c. # ###################################################################### */ #ifndef UTILS_H #define UTILS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #define MAX(a,b) ((a)>(b) ? (a) : (b)) #define MIN(a,b) ((a)<(b) ? (a) : (b)) #define IISNA(a) (a == NA_INTEGER) /*The element datatype; contains a double value, an abstract pointer, and a pointer to the next element. The purpose of the element is to serve in generic stacks and queues, which are needed for a number of purposes (including the BFS algorithms used here).*/ typedef struct elementtype{ double val; void *dp; struct elementtype *next; } element; /*Element datatypes for skip lists. These are fairly similar to "elements," except that they add an extra "depth" parameter to keep track of the length of the pointer vector contained in next (as opposed to the single pointer for a standard element). The list itself will ultimately look something like this: head -> el1 -> el2 -> el3 -> el4 -> el5 -> el6 -> el7 | | | | | | ph1 --> p11 --------> p31 -> p41 -> p51 --------> p71 | | | | ph2 --> p12 --------> p32 --------> p52 | | | ph3 ----------------> p33 --------> p53 Note that the initial pointer to the next element is intended to be the first element of next, and is carried by all list members. Additional pointers may also be carried, this being (of course) random. In practice, skip lists always require a head pointer with depth equal to the maximum list depth; it may be helpful to maintain the list length in its val entry (and this is done here). Important implementation note: as used here, depth=length(next vector)-1 (i.e., the mandatory first element is not included). This allows el->next[depth] to be the outermost pointer, with depth==0 denoting the minimal case. (Otherwise, we'd have an extra subtraction operation carried through all of our lookup routines, for no particularly good reason.) Just bear in mind that the length of the next vector is depth+1, in case this is important for some application or other. */ typedef struct slelementtype{ double val; void *dp; struct slelementtype **next; int depth; } slelement; /*The snaNet datatype; contains incoming/outgoing edge lists for each vertex, as well as network size information. This is not intended to be a very fancy structure (for that, use the network package), but is a useful, relatively light-weight tool for backend processing of large, sparse graphs.*/ typedef struct snaNettype{ int n, *outdeg,*indeg; slelement **oel,**iel; } snaNet; /*The dtelement datatype; contains a double value, a vector of "upper" and "lower" bound values, an abstract data pointer, a dimensional value, and a pointer to a vector of child elements. The purpose of the element is to serve in dimensional trees, which are needed for some of the graph layout algorithms. In general usage, each element will cover a rectangular spatial cell with "upper left" coordinates *ub and "lower right" coordinates *lb (the length of each being given by dim). Typically, **next will have dim^2 elements, each containing an equal sub-region of that spanned by *ub,*lb. Leaf nodes w/out children store data values.*/ typedef struct dtelementtype{ double val,*ub,*lb; void *dp; int dim; struct dtelementtype **next; } dtelement; /*Simple list structures to be used for temporary storage of vertex sets.*/ typedef struct vlisttype{ long int v; struct vlisttype *next; } vlist; typedef struct vcelltype{ int id; double count,xm,ym; struct vlisttype *memb; struct vcelltype *next; } vcell; /*INTERNAL ROUTINES---------------------------------------------------------*/ /*snaNet ALLOCATION/MANIPULATION ROUTINES*/ snaNet *adjMatTosnaNet(double *mat, int *n); snaNet *elMatTosnaNet(double *mat, int *n, int *m); slelement *snaFirstEdge(snaNet *g, int i, int type); int snaIsAdjacent(int i, int j, snaNet *g, int checkna); /*STACK/QUEUE/LIST ROUTINES*/ int isInSList(slelement *head, double val); slelement *slistDelete(slelement *head, double val); slelement *slistInsert(slelement *head, double val, void *dp); void slistPrint(slelement *head); slelement *slistSearch(slelement *head, double val); int isInList(element *head, double val); element *listInsert(element *head, double val, void *dp); element pop(element *head); element *push(element *head, double val, void *dp); element *pushCalloc(element *head, double val, void *dp); element *clearstack(element *head); long int stacklen(element *head); char isinstack(element *head,double val); element stackdel(element *head,double val); element dequeue(element *head); element *enqueue(element *head, double val, void *dp); element *clearqueue(element *head); long int queuelen(element *head); char isinqueue(element *head,double val); element queuedel(element *head,double val); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void aggarray3d_R(double *a, double *w, double *mat, int *m, int *n); void dyadcode_R(double *mat, int *n, int *m, double *dc); void logadd_R(double *lvals, int *n, double *lsum); void logsub_R(double *lx, double *ly, int *n, double *ldiff); #endif sna/src/likelihood.c0000644000176200001440000007606714533477237014150 0ustar liggesusers/* ###################################################################### # # likelihood.c # # copyright (c) 2004, Carter T. Butts # Last Modified 3/10/05 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related likelihood calculation for # stochastic network models. # ###################################################################### */ #include #include #include #include "likelihood.h" double bn_lpka(long int k,double pi, double sigma, double rho, double d) /*Return the log conditional probability of an asymetric dyad with k parents, under a biased net model. Parameters are as follows: sigma = Pr( x->y | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) */ { double dk,lnbpar,lnbsib,lnbdblr,lne,lpe1; /*Create building blocks*/ dk=(double)k; lnbpar=log(1.0-pi); lnbsib=log(1.0-sigma)*dk; lnbdblr=log(1.0-rho)*dk; lne=log(1-d); /*Precompute stuff*/ lpe1=log(1.0-exp(lnbsib+lne)); /*Return the log-probability of an asymetric dyad*/ return lpe1+lnbpar+lnbsib+lnbdblr+lne; } double bn_lpkm(long int k,double pi, double sigma, double rho, double d) /*Return the log conditional probability of a mutual dyad with k parents, under a biased net model. Parameters are as follows: sigma = Pr( x->y | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) */ { double dk,lne,lnbsib,lnbpar,lnbdblr,lpe1,lpe2; /*Create building blocks*/ dk=(double)k; lnbpar=log(1.0-pi); lnbsib=log(1.0-sigma)*dk; lnbdblr=log(1.0-rho)*dk; lne=log(1-d); /*Precompute stuff*/ lpe1=log(1.0-exp(lnbsib+lne)); lpe2=log(1.0-exp(lnbpar+lnbsib+lnbdblr+lne)); /*Return the log-probability of a mutual dyad*/ return lpe1+lpe2; } double bn_lpkn(long int k,double pi, double sigma, double rho, double d) /*Return the log conditional probability of a null dyad with k parents, under a biased net model. Parameters are as follows: sigma = Pr( x->y | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) */ { double dk,lnbsib,lnbdblr,lnbpar,lne,p1,p2; /*Create building blocks*/ dk=(double)k; lnbpar=log(1.0-pi); lnbsib=dk*log(1.0-sigma); lnbdblr=dk*log(1.0-rho); lne=log(1.0-d); /*Precompute stuff*/ p1=1.0-exp(lnbsib+lne); p2=1.0+exp(lnbpar+lnbsib+lnbdblr+lne); /*Return the log-probability of a null dyad*/ return log(1.0-p1*p2); } double bn_lpt_M(long int m,double pi,double sigma,double rho,double d) { return log(1.0 - (1.0-pi)*pow(1.0-rho,(double)m)*pow(1.0-sigma,(double)m)*(1.0-d)) + log(1.0-pow(1.0-sigma,(double)m)*(1.0-d)); } double bn_lpt_a(long int m,double pi,double sigma,double rho,double d) { return log(1.0-pow(1.0-sigma,(double)m)*(1.0-d)) + log((1.0-pi)*pow(1.0-rho,(double)m)*pow(1.0-sigma,(double)m)*(1.0-d)); } double bn_lpt_N(long int m,double pi,double sigma,double rho,double d) { double calc; calc = 1.0 - exp(bn_lpt_M(m,pi,sigma,rho,d)) - 2.0*exp(bn_lpt_a(m,pi,sigma,rho,d)); /*Check for numerical pathologies*/ if(calc<0.0) calc=0.0; return log(calc); } double bn_lpt_Mp1(long int m,double pi,double sigma,double rho,double d) { return bn_lpt_M(m+1,pi,sigma,rho,d); } double bn_lpt_ap1(long int m,double pi,double sigma,double rho,double d) { return bn_lpt_a(m+1,pi,sigma,rho,d); } double bn_lpt_Np1(long int m,double pi,double sigma,double rho,double d) { return bn_lpt_N(m+1,pi,sigma,rho,d); } double bn_lpt_M1(double pi,double sigma,double rho,double d) { return log(sigma*(1.0-(1.0-sigma)*(1.0-rho))); } double bn_lpt_a1(double pi,double sigma,double rho,double d) { return log(sigma*(1.0-sigma)*(1.0-rho)); } double bn_lpt_N1(double pi,double sigma,double rho,double d) { return log(1.0-sigma*(1.0+(1.0-sigma)*(1.0-rho))); } double bn_lpt_Sr(double pi,double sigma,double rho,double d) { return log(1.0-(1.0-sigma)*(1.0-rho)); } double bn_lpt_1mSr(double pi,double sigma,double rho,double d) { return log((1.0-sigma)*(1.0-rho)); } double bn_lpt(int xy, int yx, int yz, int zy, int xz, int zx, long int kxy, long int kyz, long int kxz, double pi, double sigma, double rho, double d) /*Return the log conditional probability of an x,y,z triad with dyad parent counts specified by the respective k parameters, under a biased net model. Bias parameters are as follows: sigma = Pr( x->y | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) Note that this uses the table in Skvoretz (2003). */ { if(xy>0){ if(yx>0){ if(yz>0){ if(zy>0){ if(xz>0){ if(zx>0){ /*1 1 1 1 1 1*/ return log((exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_Mp1(kxz,pi,sigma,rho,d)) + exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_Mp1(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d))+exp(bn_lpt_Mp1(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d)))/3.0 + (exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_Mp1(kyz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d)) + exp(bn_lpt_Mp1(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d))) + exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_Mp1(kxz,pi,sigma,rho,d))+2.0*exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d))+exp(bn_lpt_Mp1(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d))) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_Mp1(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d))+2.0*exp(bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d)) + exp(bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_Mp1(kxz,pi,sigma,rho,d))))/3.0 +4.0*(exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))+exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d)))/3.0 + (exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d)) + exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d)))/3.0); }else{ /*1 1 1 1 1 0*/ return log(exp(bn_lpt_M(kxy,pi,sigma,rho,d)) * (exp(bn_lpt_ap1(kxz,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Mp1(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)))/3.0 + 2.0*exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))/3.0 + exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); } }else{ if(zx>0){ /*1 1 1 1 0 1*/ return log(exp(bn_lpt_M(kyz,pi,sigma,rho,d)) * (exp(bn_lpt_ap1(kxz,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Mp1(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)))/3.0 + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))/3.0 + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + exp(bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); }else{ /*1 1 1 1 0 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kxz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kxz,pi,sigma,rho,d))) - log(3.0); } } }else{ if(xz>0){ if(zx>0){ /*1 1 1 0 1 1*/ return log(exp(bn_lpt_M(kxy,pi,sigma,rho,d)) * (exp(bn_lpt_ap1(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_Mp1(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)))/3.0 + 2.0*exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))/3.0 + exp(bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_ap1(kyz,pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); }else{ /*1 1 1 0 1 0*/ return log(exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_ap1(kxz,pi,sigma,rho,d)) + exp(bn_lpt_ap1(kxz,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d))+exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*1 1 1 0 0 1*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) - log(3.0); }else{ /*1 1 1 0 0 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kxz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kxz,pi,sigma,rho,d))) - log(3.0); } } } }else{ if(zy>0){ if(xz>0){ if(zx>0){ /*1 1 0 1 1 1*/ return log(exp(bn_lpt_M(kxz,pi,sigma,rho,d)) * (exp(bn_lpt_ap1(kyz,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_Mp1(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)))/3.0 + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))/3.0 + exp(bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_ap1(kyz,pi,sigma,rho,d)) + exp(bn_lpt_a(kyz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); }else{ /*1 1 0 1 1 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kyz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*1 1 0 1 0 1*/ return log(exp(bn_lpt_Mp1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_M(kxy,pi,sigma,rho,d)) + 4.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*1 1 0 1 0 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*1 1 0 0 1 1*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kyz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kyz,pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*1 1 0 0 1 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kyz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kyz,pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*1 1 0 0 0 1*/ return bn_lpt_M(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*1 1 0 0 0 0*/ return bn_lpt_M(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } } }else{ if(yz>0){ if(zy>0){ if(xz>0){ if(zx>0){ /*1 0 1 1 1 1*/ return log(exp(bn_lpt_M(kyz,pi,sigma,rho,d)) * (exp(bn_lpt_ap1(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_Mp1(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)))/3.0 + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))/3.0 + exp(bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); }else{ /*1 0 1 1 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) - log(3.0); } }else{ if(zx>0){ /*1 0 1 1 0 1*/ return log(exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_ap1(kxz,pi,sigma,rho,d)) + exp(bn_lpt_ap1(kxy,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d))+exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d) - log(3.0); }else{ /*1 0 1 1 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxz,pi,sigma,rho,d))) - log(3.0); } } }else{ if(xz>0){ if(zx>0){ /*1 0 1 0 1 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Mp1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_M(kxz,pi,sigma,rho,d)) + 4.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d))) - log(3.0); }else{ /*1 0 1 0 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) - log(3.0); } }else{ if(zx>0){ /*1 0 1 0 0 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) - log(3.0); }else{ /*1 0 1 0 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxz,pi,sigma,rho,d) + bn_lpt_N1(pi,sigma,rho,d))) - log(3.0); } } } }else{ if(zy>0){ if(xz>0){ if(zx>0){ /*1 0 0 1 1 1*/ return log(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*1 0 0 1 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*1 0 0 1 0 1*/ return log(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*1 0 0 1 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*1 0 0 0 1 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_M(kxz,pi,sigma,rho,d); }else{ /*1 0 0 0 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*1 0 0 0 0 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*1 0 0 0 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } } } }else{ if(yx>0){ if(yz>0){ if(zy>0){ if(xz>0){ if(zx>0){ /*0 1 1 1 1 1*/ return log(exp(bn_lpt_M(kyz,pi,sigma,rho,d))*(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d)+bn_lpt_M(kxz,pi,sigma,rho,d))+exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_Mp1(kxz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d))+exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_M(kxz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0+2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_M(kyz,pi,sigma,rho,d)+bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d))/3.0+exp(bn_lpt_M(kyz,pi,sigma,rho,d)+bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d))*(exp(bn_lpt_a(kxy,pi,sigma,rho,d))+1.0+exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0+2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_M(kyz,pi,sigma,rho,d)+bn_lpt_M(kxz,pi,sigma,rho,d)+bn_lpt_a1(pi,sigma,rho,d))/3.0+2.0*exp(bn_lpt_M(kyz,pi,sigma,rho,d))*(exp(bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kxz,pi,sigma,rho,d)+bn_lpt_a1(pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d))+exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kxz,pi,sigma,rho,d)+bn_lpt_M1(pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)))/3.0); }else{ /*0 1 1 1 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Mp1(kyz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_M(kyz,pi,sigma,rho,d)) + 4.0*exp(bn_lpt_a(kyz,pi,sigma,rho,d)+bn_lpt_Sr(pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*0 1 1 1 0 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_M(kyz,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kxz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) - log(3.0); }else{ /*0 1 1 1 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_M(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*0 1 1 0 1 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kyz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_M(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 1 1 0 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_ap1(kyz,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*0 1 1 0 0 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*0 1 1 0 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } }else{ if(zy>0){ if(xz>0){ if(zx>0){ /*0 1 0 1 1 1*/ return log(exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_ap1(kyz,pi,sigma,rho,d)) + exp(bn_lpt_ap1(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d)) + exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+bn_lpt_a1(pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a1(pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d))) + bn_lpt_M(kxz,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d) - log(3.0); }else{ /*0 1 0 1 1 0*/ return log(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d) + bn_lpt_1mSr(pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d) + bn_lpt_a1(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*0 1 0 1 0 1*/ return log(exp(bn_lpt_ap1(kxy,pi,sigma,rho,d))+2.0*exp(bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_1mSr(pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a1(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 1 0 1 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*0 1 0 0 1 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kyz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kyz,pi,sigma,rho,d)+bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_M(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 1 0 0 1 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d) + log(exp(bn_lpt_Np1(kyz,pi,sigma,rho,d))+2.0*exp(bn_lpt_N(kyz,pi,sigma,rho,d)+bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); } }else{ if(zx>0){ /*0 1 0 0 0 1*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*0 1 0 0 0 0*/ return bn_lpt_a(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } } }else{ if(yz>0){ if(zy>0){ if(xz>0){ if(zx>0){ /*0 0 1 1 1 1*/ return log(exp(bn_lpt_Np1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d) + bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 0 1 1 1 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_M(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*0 0 1 1 0 1*/ return log(exp(bn_lpt_Np1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d) + bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_M(kyz,pi,sigma,rho,d) + bn_lpt_a(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 0 1 1 0 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_M(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*0 0 1 0 1 1*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_M(kxz,pi,sigma,rho,d); }else{ /*0 0 1 0 1 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*0 0 1 0 0 1*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*0 0 1 0 0 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } }else{ if(zy>0){ if(xz>0){ if(zx>0){ /*0 0 0 1 1 1*/ return log(exp(bn_lpt_Np1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d) + bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_a(kyz,pi,sigma,rho,d) + bn_lpt_M(kxz,pi,sigma,rho,d) - log(3.0); }else{ /*0 0 0 1 1 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*0 0 0 1 0 1*/ return log(exp(bn_lpt_Np1(kxy,pi,sigma,rho,d)) + 2.0*exp(bn_lpt_N(kxy,pi,sigma,rho,d) + bn_lpt_N1(pi,sigma,rho,d))) + bn_lpt_a(kxz,pi,sigma,rho,d) + bn_lpt_a(kyz,pi,sigma,rho,d) - log(3.0); }else{ /*0 0 0 1 0 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_a(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } }else{ if(xz>0){ if(zx>0){ /*0 0 0 0 1 1*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_M(kxz,pi,sigma,rho,d); }else{ /*0 0 0 0 1 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); } }else{ if(zx>0){ /*0 0 0 0 0 1*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_a(kxz,pi,sigma,rho,d); }else{ /*0 0 0 0 0 0*/ return bn_lpt_N(kxy,pi,sigma,rho,d)+bn_lpt_N(kyz,pi,sigma,rho,d)+ bn_lpt_N(kxz,pi,sigma,rho,d); } } } } } } } void bn_dyadstats_R(int *g, double *pn, double *stats) /*Return the matrix of sufficient dyad statistics for a biased net model, using the method of Skvoretz et al.*/ { long int n,i,j,k,parents; /*Initialize the stats structure*/ n=(long int)*pn; for(i=0;i0)&&(g[k+j*n]>0)) parents++; /*Increment the appropriate statistic*/ if(g[i+j*n]>0){ if(g[j+i*n]>0){ /*Mutual*/ stats[parents+(n-1)]++; }else{ /*Asym*/ stats[parents+(n-1)*2]++; } }else{ if(g[j+i*n]>0){ /*Asym*/ stats[parents+(n-1)*2]++; }else{ /*Null*/ stats[parents+(n-1)*3]++; } } } } void bn_triadstats_R(int *g, double *pn, double *stats) /*Compute the matrix of parent statistics for a biased net model, using the method of Skvoretz (2003). In particular, stats will be filled with an adjacency matrix containing the dyadic parent counts.*/ { long int n,i,j,k; n=(long int)*pn; /*Accumulate parent counts*/ for(i=0;i0)&&(g[k+j*n]>0)) stats[i+j*n]++; }else if(i==j){ stats[i+j*n]=0.0; /*Treat diagonal as zero*/ }else{ stats[i+j*n]=stats[j+i*n]; /*Use what we already have*/ } } void bn_lpl_dyad_R(double *stats, double *psr, double *pi, double *sigma, double *rho, double *d, double *lpl) /*Return the dyadic log pseudolikelihood for a given graph under a biased net model. Parameters are as follows: stats = a *psr x 4 matrix, whose rows contain # parents, # mutuals, # asymmetrics, and # nulls (in order) sigma = Pr( x->y | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) lpl = a pointer to the likelihood */ { long int sr,i; /*Calculate the log pseudolikelihood*/ *lpl=0.0; sr=(long int)(*psr); for(i=0;iy | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) lpl = a pointer to the likelihood */ { long int i,j,k,n; n=(long int)*pn; /*Calculate the log pseudolikelihood*/ *lpl=0.0; for(i=0;iy | xSy ) (Transitivity or "sibling" bias) pi = Pr( x->y | y->x ) (Reciprocity or "parent" bias) rho = Pr( x->y | y->x & xSy ) ("Double role" bias, or interaction effect) d = Pr( x->y ) (Baseline density effect) pt = a pointer to the triad probabilities */ { double pi,sigma,rho,d,M0,a0,N0,M1,a1,N1,Mp1,ap1,Np1,Sr; /*Initialize for convenience*/ pi=*ppi; sigma=*psigma; rho=*prho; d=*pd; /*Compute the simplifying factors*/ M0=d*(pi+(1.0-pi)*d); a0=d*(1.0-d)*(1.0-pi); N0=(1.0-d)*(1.0-d*(1.0-pi)); M1=(sigma+(1.0-sigma)*d)*(1.0-(1.0-pi)*(1.0-sigma)*(1.0-rho)*(1.0-d)); a1=(sigma+(1.0-sigma)*d)*(1.0-pi)*(1.0-sigma)*(1.0-rho)*(1.0-d); N1=1.0-(sigma+(1.0-sigma)*d)*(1.0+(1.0-pi)*(1.0-sigma)*(1.0-rho)*(1.0-d)); Mp1=sigma*(1.0-(1.0-sigma)*(1.0-rho)); ap1=sigma*(1.0-sigma)*(1.0-rho); Np1=1.0-sigma*(1.0-(1.0-sigma)*(1.0-rho)+2.0*(1.0-sigma)*(1.0-rho)); Sr=1.0-(1.0-sigma)*(1.0-rho); /*Compute the actual triad probabilities*/ pt[0]=N0*N0*N0; /*003*/ pt[1]=6.0*a0*N0*N0; /*012*/ pt[2]=3.0*M0*N0*N0; /*102*/ pt[3]=a0*a0*(N1+2.0*N0*Np1); /*021D*/ /*This fixes a typo in SN article*/ pt[4]=3.0*a0*a0*N0; /*021U*/ pt[5]=6.0*a0*a0*N0; /*021C*/ pt[6]=6.0*M0*a0*N0; /*111D*/ pt[7]=2.0*M0*a0*(N1+2.0*N0*Np1); /*111U*/ pt[8]=2.0*a0*a0*(a1+2.0*a0*(1-Sr)+2.0*N0*ap1); /*030T*/ pt[9]=2.0*a0*a0*a0; /*030C*/ pt[10]=M0*M0*(N1+2*N0*Np1); /*201*/ pt[11]=a0*a0*(M1+2.0*M0+2.0*N0*Mp1+4.0*a0*Sr); /*120D*/ pt[12]=M0*a0*(1.0-Sr)*(2.0*a1+a0*(1.0-Sr)+4.0*N0*ap1); /*120U*/ pt[13]=2.0*M0*a0*(a1+2.0*a0*(1-Sr)+2*N0*ap1); /*120C*/ pt[14]=M0*(2.0*M0*a1+2.0*a0*M1*(1.0-Sr)+2.0*M0*a0*(1.0-Sr)+ 4.0*a0*N0*ap1*Sr+4.0*a0*N0*Mp1*(1.0-Sr)+4.0*M0*N0*ap1+2.0*a0*a1*Sr+6.0*a0*a0*Sr*(1.0-Sr)); /*210*/ pt[15]=M0*(M0*M1+4.0*a0*N0*Mp1*Sr+2.0*M0*N0*Mp1+5*a0*a0*Sr*Sr+ 2.0*a0*M1*Sr+2.0*M0*a0*Sr); /*300*/ } sna/src/cohesion.h0000644000176200001440000000314414533477405013620 0ustar liggesusers/* ###################################################################### # # cohesion.h # # copyright (c) 2007, Carter T. Butts # Last Modified 5/1/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for cohesion.c. # ###################################################################### */ #ifndef COHESION_H #define COHESION_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include #include "utils.h" #include "components.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ void bicomponentRecurse(snaNet *g, element *complist, element *estack, int *parent, int *num, int *back, int *dfn, int v); slelement *cliqueFirstChild(snaNet *g, slelement *cl); void cliqueRecurse(snaNet *g, slelement *k, int parind, element **clist, double *ccount, int *compmemb); void cutpointUndirRecurse(snaNet *g, int *cpstatus, int *minvis, int *visdep, int depth, int v, int src); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ SEXP bicomponents_R(SEXP net, SEXP sn, SEXP sm); SEXP cliques_R(SEXP net, SEXP sn, SEXP sm, SEXP stabulatebyvert, SEXP scomembership, SEXP senumerate); void cutpointsDir_R(double *mat, int *n, int *m, int *cpstatus); void cutpointsUndir_R(double *mat, int *n, int *m, int *cpstatus); void kcores_R(double *mat, int *n, int *m, double *corevec, int *dtype, int *pdiag, int *pigeval); #endif sna/src/paths.h0000644000176200001440000000314214533477330013123 0ustar liggesusers/* ###################################################################### # # paths.h # # copyright (c) 2007, Carter T. Butts # Last Modified 3/27/09 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for paths.c. # ###################################################################### */ #ifndef PATHS_H #define PATHS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include "utils.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ void edgewisePathRecurse(snaNet *g, int src, int dest, int curnode, int *availnodes, int availcount, int *usednodes, int curlen, double *count, double *cpcount, double *dpcount, int maxlen, int directed, int byvertex, int copaths, int dyadpaths); void edgewiseCycleCensus(snaNet *g, int src, int dest, double *count, double *cccount, int maxlen, int directed, int byvertex, int cocycles); void dyadPathCensus(snaNet *g, int src, int dest, double *count, double *cpcount, double *dpcount, int maxlen, int directed, int byvertex, int copaths, int dyadpaths); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void cycleCensus_R(int *g, int *pn, int *pm, double *count, double *cccount, int *pmaxlen, int *pdirected, int *pbyvertex, int *pcocycles); void pathCensus_R(double *g, int *pn, int *pm, double *count, double *cpcount, double *dpcount, int *pmaxlen, int *pdirected, int *pbyvertex, int *pcopaths, int *pdyadpaths); #endif sna/src/components.h0000644000176200001440000000306114533477377014204 0ustar liggesusers/* ###################################################################### # # components.h # # copyright (c) 2004, Carter T. Butts # Last Modified 7/19/16 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains headers for components.c. # ###################################################################### */ #ifndef COMPONENTS_H #define COMPONENTS_H /*DECLARATIONS/INCLUSIONS---------------------------------------------------*/ #include #include #include #include #include #include "utils.h" /*INTERNAL ROUTINES---------------------------------------------------------*/ slelement *BFS(snaNet *g, int *n, int v, int transpose); element *BFS_unord(snaNet *g, int *n, int v, int transpose); int numStrongComponents(snaNet *g, int *n); slelement *strongComponentByVertex(snaNet *g, int *n, int v); int *strongComponents(snaNet *g, int *n); void strongComponentsRecurse(snaNet *g, int *n, int v, int *rindex, int *index, int *ccount, element *dfs); int *undirComponents(snaNet *g); void undirComponentsRecurse(snaNet *g,int v,int *memb); void undirComponentsNoRecurse(snaNet *g, int *memb); /*R-CALLABLE ROUTINES-------------------------------------------------------*/ void component_dist_R(double *g, double *pn, double *memb); void compsizes_R(double *mat, int *n, int *m, int *csizes); SEXP reachability_R(SEXP mat, SEXP sn, SEXP sm); void undirComponents_R(double *mat, int *n, int *m, int *memb); #endif sna/src/triads.c0000644000176200001440000002710614533477171013276 0ustar liggesusers/* ###################################################################### # # triads.c # # copyright (c) 2004, Carter T. Butts # Last Modified 2/27/13 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to the classification and # counting of triads. # ###################################################################### */ #include #include #include #include "triads.h" int triad_classify(int *g, int gn, int i, int j, int k, int gm) /* If gm=1, compute a Holland and Leinhardt classification for the {i,j,k} triad in graph g; otherwise, compute the four-state undirected classification. Note that this routine assumes dichotomized data. This function assumes that g is encoded in adjacency matrix form. This routine is not intended to be called from R. */ { int m,a,n,di,dj,dk; /*If we are in the undirected case, take the easy way out*/ if(!gm) return g[i+j*gn]+g[j+k*gn]+g[i+k*gn]; /*Get MAN information*/ m=g[i+j*gn]*g[j+i*gn]+g[i+k*gn]*g[k+i*gn]+g[j+k*gn]*g[k+j*gn]; n=(1-g[i+j*gn])*(1-g[j+i*gn])+(1-g[i+k*gn])*(1-g[k+i*gn])+(1-g[j+k*gn])*(1-g[k+j*gn]); a=3-m-n; /*Now classify, using dyad census as a first cut*/ if(n==3) /*003*/ return 0; else if((a==1)&&(n==2)) /*012*/ return 1; else if((m==1)&&(n==2)) /*102*/ return 2; else if((a==2)&&(n==1)){ /*021*/ di=g[i+j*gn]+g[i+k*gn]; if(di==2) return 3; /*021D*/ dj=g[j+i*gn]+g[j+k*gn]; if(dj==2) return 3; /*021D*/ dk=g[k+i*gn]+g[k+j*gn]; if(dk==2) return 3; /*021D*/ di=g[j+i*gn]+g[k+i*gn]; if(di==2) return 4; /*021U*/ dj=g[i+j*gn]+g[k+j*gn]; if(dj==2) return 4; /*021U*/ dk=g[i+k*gn]+g[j+k*gn]; if(dk==2) return 4; /*021U*/ return 5; /*021C*/ }else if((m==1)&&(n==1)){ /*111*/ di=g[j+i*gn]+g[k+i*gn]; if((di==0)||(di==2)) return 6; /*111D*/ dj=g[i+j*gn]+g[k+j*gn]; if((dj==0)||(dj==2)) return 6; /*111D*/ return 7; /*111U*/ }else if(a==3){ /*030*/ di=g[j+i*gn]+g[k+i*gn]; if((di==2)||(di==0)) return 8; /*030T*/ dj=g[i+j*gn]+g[k+j*gn]; if((dj==2)||(dj==0)) return 8; /*030T*/ return 9; /*030C*/ }else if((m==2)&&(n==1)) /*201*/ return 10; else if((m==1)&&(a==2)){ /*120*/ di=g[j+i*gn]+g[k+i*gn]; if(di==0) return 11; /*120D*/ dj=g[i+j*gn]+g[k+j*gn]; if(dj==0) return 11; /*120D*/ dk=g[i+k*gn]+g[j+k*gn]; if(dk==0) return 11; /*120D*/ di=g[i+j*gn]+g[i+k*gn]; if(di==0) return 12; /*120U*/ dj=g[j+i*gn]+g[j+k*gn]; if(dj==0) return 12; /*120U*/ dk=g[k+i*gn]+g[k+j*gn]; if(dk==0) return 12; /*120U*/ return 13; /*120C*/ }else if((m==2)&&(a==1)) /*210*/ return 14; else /*300*/ return 15; } int triad_classify_el(snaNet *g, int i, int j, int k, int gm, int checkna) /* If gm=1, compute a Holland and Leinhardt classification for the {i,j,k} triad in graph g; otherwise, compute the four-state undirected classification. Note that this routine assumes dichotomized data; if checkna is true, edge states are checked for missingness. Specifically, checkna=1 results in a return value of NA_INTEGER for triads with missing edges, and checkna=2 results in such edges being treated as absent (with checkna=0 implying no checks). This routine is not intended to be called from R. */ { int sij=0,sji=0,sjk=0,skj=0,sik=0,ski=0,m,a,n,di,dj,dk; /*Get the raw edge states*/ sij=snaIsAdjacent(i,j,g,checkna); sjk=snaIsAdjacent(j,k,g,checkna); sik=snaIsAdjacent(i,k,g,checkna); if(gm){ sji=snaIsAdjacent(j,i,g,checkna); skj=snaIsAdjacent(k,j,g,checkna); ski=snaIsAdjacent(k,i,g,checkna); } /*If necessary, check for missingness*/ if(checkna==1){ if(IISNA(sij)||IISNA(sjk)||IISNA(sik)) return NA_INTEGER; if(gm) if(IISNA(sji)||IISNA(skj)||IISNA(ski)) return NA_INTEGER; } /*If we are in the undirected case, take the easy way out*/ if(!gm){ return sij+sjk+sik; } /*Get MAN information*/ m=(sij*sji)+(sjk*skj)+(sik*ski); n=((sij+sji)==0)+((sjk+skj)==0)+((sik+ski)==0); a=3-m-n; /*Now classify, using dyad census as a first cut*/ if(n==3) /*003*/ return 0; else if((a==1)&&(n==2)) /*012*/ return 1; else if((m==1)&&(n==2)) /*102*/ return 2; else if((a==2)&&(n==1)){ /*021*/ di=sij+sik; if(di==2) return 3; /*021D*/ dj=sji+sjk; if(dj==2) return 3; /*021D*/ dk=ski+skj; if(dk==2) return 3; /*021D*/ di=sji+ski; if(di==2) return 4; /*021U*/ dj=sij+skj; if(dj==2) return 4; /*021U*/ dk=sik+sjk; if(dk==2) return 4; /*021U*/ return 5; /*021C*/ }else if((m==1)&&(n==1)){ /*111*/ di=sji+ski; if((di==0)||(di==2)) return 6; /*111D*/ dj=sij+skj; if((dj==0)||(dj==2)) return 6; /*111D*/ return 7; /*111U*/ }else if(a==3){ /*030*/ di=sji+ski; if((di==2)||(di==0)) return 8; /*030T*/ dj=sij+skj; if((dj==2)||(dj==0)) return 8; /*030T*/ return 9; /*030C*/ }else if((m==2)&&(n==1)) /*201*/ return 10; else if((m==1)&&(a==2)){ /*120*/ di=sji+ski; if(di==0) return 11; /*120D*/ dj=sij+skj; if(dj==0) return 11; /*120D*/ dk=sik+sjk; if(dk==0) return 11; /*120D*/ di=sij+sik; if(di==0) return 12; /*120U*/ dj=sji+sjk; if(dj==0) return 12; /*120U*/ dk=ski+skj; if(dk==0) return 12; /*120U*/ return 13; /*120C*/ }else if((m==2)&&(a==1)) /*210*/ return 14; else /*300*/ return 15; } void triad_classify_R(int *g, int *tt, int *gm) /* Given a triadic adjacency matrix, classify the triad in question. Note that this routine assumes dichotomized data. (This is a wrapper for triad_classify.) This routine may be called from R using .C. */ { /*Perform the classification*/ *tt=triad_classify(g,3,0,1,2,*gm); } void transitivity_R(double *mat, int *n, int *m, double *t, int *meas, int *checkna) /* Compute transitivity information for the (edgelist) network in mat. This is stored in t, with t[0] being the number of ordered triads at risk for transitivity, and t[1] being the number satisfying the condition. The definition used is controlled by meas, with meas==1 implying the weak condition (a->b->c => a->c), meas==0 implying the strong condition (a->b->c <=>a->c), meas==2 implying the rank condition (a->c >= min(a->b,b->c)), and meas==3 implying Dekker's correlation measure (cor(a->c,a->b*b->c)). If checkna==0, the measures are computed without missingness checks (i.e., treating NA edges as present). If checkna==1, any triad containing missing edges is omitted from the total count. Finally, if checkna==2, missing edges are treated as absent by the routine. This routine may be called from R using .C. */ { int i,j,k,sij,sjk,sik; double ev; snaNet *g; slelement *jp,*kp,*ikp; /*Form the snaNet and initialize t*/ GetRNGstate(); //Rprintf("Building network, %d vertices and %d edges\n",*n,*m); g=elMatTosnaNet(mat,n,m); //Rprintf("Build complete. Proceeding.\n"); PutRNGstate(); t[0]=t[1]=0.0; /*Get the transitivity information*/ switch(*meas){ case 0: /*"Strong" form: i->j->k <=> i->k*/ for(i=0;in;i++) for(j=0;jn;j++) if(i!=j){ for(k=0;kn;k++) if((j!=k)&&(i!=k)){ sij=snaIsAdjacent(i,j,g,*checkna); sjk=snaIsAdjacent(j,k,g,*checkna); sik=snaIsAdjacent(i,k,g,*checkna); if(!(IISNA(sij)||IISNA(sjk)||IISNA(sik))){ t[0]+=sij*sjk*sik+(1-sij*sjk)*(1-sik); t[1]++; } } } break; case 1: /*"Weak" form: i->j->k => i->k*/ for(i=0;in;i++){ for(jp=snaFirstEdge(g,i,1);jp!=NULL;jp=jp->next[0]){ if((i!=(int)(jp->val))&&((*checkna==0)||(!ISNAN(*((double *)(jp->dp)))))){ /*Case 1 acts like case 2 here*/ for(kp=snaFirstEdge(g,(int)(jp->val),1);kp!=NULL;kp=kp->next[0]){ if(((int)(jp->val)!=(int)(kp->val))&&(i!=(int)(kp->val))&& ((*checkna==0)||(!ISNAN(*((double *)(kp->dp)))))){ sik=snaIsAdjacent(i,(int)(kp->val),g,*checkna); if(!IISNA(sik)){ /*Not counting in case 1 (but am in case 2)*/ t[0]+=sik; t[1]++; } } } } } } break; case 2: /*"Rank" form: i->k >= min(i->j,j->k)*/ for(i=0;in;i++){ for(jp=snaFirstEdge(g,i,1);jp!=NULL;jp=jp->next[0]){ if((i!=(int)(jp->val))&&((*checkna==0)||(!ISNAN(*((double *)(jp->dp)))))){ /*Case 1 acts like case 2 here*/ for(kp=snaFirstEdge(g,(int)(jp->val),1);kp!=NULL;kp=kp->next[0]){ if(((int)(jp->val)!=(int)(kp->val))&&(i!=(int)(kp->val))&& ((*checkna==0)||(!ISNAN(*((double *)(kp->dp)))))){ sik=snaIsAdjacent(i,(int)(kp->val),g,*checkna); if(!IISNA(sik)){ /*Not counting in case 1 (but am in case 2)*/ if(sik){ ikp=slistSearch(g->oel[i],kp->val); /*We already verified that it is here*/ ev=*((double *)(ikp->dp)); }else{ ev=0.0; } if((*checkna==0)||(!ISNAN(ev))){ t[0]+=(ev>=MIN(*((double *)(kp->dp)),*((double *)(jp->dp)))); t[1]++; } } } } } } } break; case 3: /*"Corr" form: corr(i->k, i->j * j->k)*/ error("Edgelist computation not currently supported for correlation measure in gtrans.\n"); break; } } void triad_census_R(double *mat, int *n, int *m, double *t, int *gm, int *checkna) /* Compute a Holland and Leinhardt triad census for the graph with edgelist matrix mat. It is regrettably non-optimized, although it does at least avoid having to store the entire adjacency matrix. If checkna==0, the census is computed without missingness checks (i.e., treating NA edges as present). If checkna==1, any triad containing missing edges is omitted from the total count. Finally, if checkna==2, missing edges are treated as absent by the routine. This routine may be called from R using .C. */ { int i,j,k,tc; snaNet *g; /*Form the snaNet*/ GetRNGstate(); g=elMatTosnaNet(mat,n,m); PutRNGstate(); /*Clear out triad structure*/ for(i=0;i<4+(*gm)*12;i++) /*Vector length depends on gm*/ t[i]=0.0; /*Get the triad counts*/ for(i=0;i<*n;i++) for(j=i+1;j<*n;j++) for(k=j+1;k<*n;k++){ tc=triad_classify_el(g,i,j,k,*gm,*checkna); if(!IISNA(tc)) t[tc]++; } } sna/src/layout.c0000644000176200001440000006517514667201250013324 0ustar liggesusers/* ###################################################################### # # layout.c # # copyright (c) 2004, Carter T. Butts # Last Modified 11/21/11 # Licensed under the GNU General Public License version 2 (June, 1991) # or later. # # Part of the R/sna package # # This file contains routines related to computation of vertex layouts # for gplot and gplot3d (i.e., the gplot.layout.* and gplot3d.layout.* # functions). # ###################################################################### */ #include #include #include #include #include "layout.h" /*LAYOUT UTILITY ROUTINES----------------------------------------------*/ double angdist(double a, double b, double ilen) /*This little routine calculates the angular distance between a and b, assuming a periodicity of ilen.*/ { double minang,maxang,dis; /*Order the angles for convenience*/ minang= ((a<=b) ? a : b); maxang= ((a>b) ? a : b); /*Find the distance, shifting if need be*/ dis=maxang-minang; if(dis>ilen) dis-=ilen; /*Return the result*/ return dis; } double poldist(double ra,double ta,double rb,double tb) /*Return the Euclidean distance between a and b, where both points are given in polar coordinates.*/ { return sqrt(ra*ra+rb*rb-2.0*ra*rb*cos(ta-tb)); } double pollinedist(double ra,double ta,double rb,double tb, double rc, double tc) /*Return the shortest Euclidean distance between a and the line spanning b and c, where all points are given in polar coordinates.*/ { double A,B,dpol; A=ra*(rb*sin(ta-tb)-rc*sin(ta-tc))+rb*rc*sin(tb-tc); B=(rb*cos(tb)-rc*cos(tc)) * sqrt(1.0+pow(rb*sin(tb)-rc*sin(tc),2.0)/pow(rb*cos(tb)-rc*cos(tc),2.0)); dpol=fabs(A/B); return dpol; } int poledgecross(double ra, double ta, double rb, double tb, double rc, double tc, double rd, double td) /*Checks for an edge cross between {a,b} and {c,d}, where all points are specified in polar coordinates. poledgecross() returns 1 if a cross occurs, or 0 otherwise.*/ { double ax,ay,bx,by,cx,cy,dx,dy,denom,sint,tint,scx,scy,sdx; /*Convert to Cartesian coordinates*/ ax=ra*cos(ta); ay=ra*sin(ta); bx=rb*cos(tb); by=rb*sin(tb); cx=rc*cos(tc); cy=rc*sin(tc); dx=rd*cos(td); dy=rd*sin(td); /*Compute the denomenators for the intersection*/ denom=(ax-bx)*(cy-dy)-(ay-by)*(cx-dx); if(denom==0.0){ /*Interrupt if parallel lines*/ /*Check for horizontility/verticality*/ if(ax==bx){ if((ax==cx)&&(ININT(cx,ax,bx)||ININT(dx,ax,bx))) return 1; else return 0; } if(ay==by){ if((ay==cy)&&(ININT(cy,ay,by)||ININT(dy,ay,by))) return 1; else return 0; } /*Check for collinearity*/ scx=(cx-ax)/(bx-ax); scy=(cy-ay)/(by-ay); if(scx!=scy) /*Parallel&&!collin => not intersect*/ return 0; /*If collinear, try for an intersection*/ sdx=(dx-ax)/(bx-ax); if(((scx>=0.0)&&(scx<=1.0))||((sdx>=0.0)&&(sdx<=1.0))) return 1; else return 0; } sint=(ax*(cy-dy)+ay*(dx-cx)+cx*dy-cy*dx)/denom; tint=(ax*(by-cy)+ay*(cx-bx)+bx*cy-by*cx)/(-denom); /*Return the result*/ if((sint>=0.0)&&(sint<=1.0)&&(tint>=0.0)&&(tint<=1.0)) return 1; else return 0; } /*TWO-DIMENSIONAL LAYOUT ROUTINES--------------------------------------*/ void gplot_layout_fruchtermanreingold_R(double *d, double *pn, double *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, int *pncell, double *pcjit, double *pcppr, double *pcpcr, double *pcccr, double *x, double *y) /* Calculate a two-dimensional Fruchterman-Reingold layout for (symmetrized) edgelist matrix d (2 column). Positions (stored in (x,y)) should be initialized prior to calling this routine. */ { double frk,maxdelta,volume,coolexp,repulserad,t,ded,xd,yd,*dx,*dy; double rf,af,xmax,xmin,ymax,ymin,xwid,ywid,cjit,cppr,cpcr,cccr,celldis; long int n,j,k,l,m; int niter,i,*cellid,ncell,ix,iy,jx,jy; char *vmax; vcell *vcells,*p,*p2; vlist *vlp,*vlp2; /*Define various things*/ n=(long int)*pn; m=(long int)*pm; niter=*pniter; maxdelta=*pmaxdelta; volume=*pvolume; coolexp=*pcoolexp; repulserad=*prepulserad; ncell=*pncell; cjit=*pcjit; cppr=*pcppr; cpcr=*pcpcr; cccr=*pcccr; frk=sqrt(volume/(double)n); /*Define the F-R constant*/ xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; /*Allocate memory for transient structures*/ dx=(double *)R_alloc(n,sizeof(double)); dy=(double *)R_alloc(n,sizeof(double)); cellid=(int *)R_alloc(n,sizeof(int)); /*Run the annealing loop*/ for(i=niter;i>=0;i--){ /*Check for interrupts, before messing with temporary storage*/ R_CheckUserInterrupt(); /*Allocate cell structures for this iteration*/ GetRNGstate(); vmax=vmaxget(); xmin=ymin=R_PosInf; xmax=ymax=R_NegInf; for(j=0;jnext!=NULL)&&(p->id!=cellid[j]);p=p->next); if(p==NULL){ /*Head was null; initiate*/ vcells=p=(vcell *)R_alloc(1,sizeof(vcell)); p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; }else if(p->id!=cellid[j]){ /*Got to end, insert new element*/ p->next=(vcell *)R_alloc(1,sizeof(vcell)); p=p->next; p->id=cellid[j]; p->next=NULL; p->memb=NULL; p->count=0.0; p->xm=0.0; p->ym=0.0; } /*Add j to the membership stack for this cell*/ p->count++; vlp=(vlist *)R_alloc(1,sizeof(vlist)); vlp->v=j; vlp->next=p->memb; p->memb=vlp; p->xm=((p->xm)*((p->count)-1.0)+x[j])/(p->count); p->ym=((p->ym)*((p->count)-1.0)+y[j])/(p->count); } PutRNGstate(); /*Set the temperature (maximum move/iteration)*/ t=maxdelta*pow(i/(double)niter,coolexp); /*Clear the deltas*/ for(j=0;jnext) /*Add forces at the cell level*/ for(p2=p;p2!=NULL;p2=p2->next){ /*Get cell identities*/ ix=(p->id)%ncell; jx=(p2->id)%ncell; iy=(int)floor((p->id)/ncell); jy=(int)floor((p2->id)/ncell); celldis=(double)((ix-jx)*(ix-jx)+(iy-jy)*(iy-jy)); /*Sq cell/cell dist*/ if(celldis<=cppr+0.001){ /*Use point/point calculations (exact)*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next) for(vlp2=((p==p2)?(vlp->next):(p2->memb));vlp2!=NULL; vlp2=vlp2->next){ /*Obtain difference vector*/ xd=x[vlp->v]-x[vlp2->v]; yd=y[vlp->v]-y[vlp2->v]; ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); dx[vlp->v]+=xd*rf; /*Add to the position change vector*/ dx[vlp2->v]-=xd*rf; dy[vlp->v]+=yd*rf; dy[vlp2->v]-=yd*rf; } }else if(celldis<=cpcr+0.001){ /*Use point/cell calculations (approx)*/ /*Add force increments to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p2->xm); yd=y[vlp->v]-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ xd=x[vlp->v]-(p->xm); yd=y[vlp->v]-(p->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add to dx and dy*/ dx[vlp->v]+=xd*rf*(p->count); dy[vlp->v]+=yd*rf*(p->count); } }else if(celldis<=cccr+0.001){ /*Use cell/cell calculations (crude!)*/ xd=(p->xm)-(p2->xm); yd=(p->ym)-(p2->ym); ded=sqrt(xd*xd+yd*yd); /*Get dyadic euclidean distance*/ xd/=ded; /*Rescale differences to length 1*/ yd/=ded; /*Calculate repulsive "force"*/ rf=frk*frk*(1.0/ded-ded*ded/repulserad); /*Add force increment to each member of p and p2*/ for(vlp=p->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]+=xd*rf*(p2->count); dy[vlp->v]+=yd*rf*(p2->count); } for(vlp=p2->memb;vlp!=NULL;vlp=vlp->next){ dx[vlp->v]-=xd*rf*(p->count); dy[vlp->v]-=yd*rf*(p->count); } } } /*Calculate attraction along edges*/ for(j=0;jt){ /*Dampen to t*/ ded=t/ded; dx[j]*=ded; dy[j]*=ded; } x[j]+=dx[j]; /*Update positions*/ y[j]+=dy[j]; } /*Free memory for cell membership (or at least unprotect it)*/ vmaxset(vmax); } } /*Deprecated function version is below, to be removed by 2.4*/ void gplot_layout_fruchtermanreingold_old_R(double *d, int *pn, int *pm, int *pniter, double *pmaxdelta, double *pvolume, double *pcoolexp, double *prepulserad, double *x, double *y) /* Calculate a two-dimensional Fruchterman-Reingold layout for (symmetrized) edgelist matrix d. Positions (stored in (x,y)) should be initialized prior to calling this routine. */ { double frk,maxdelta,volume,coolexp,repulserad,t,ded,xd,yd,*dx,*dy; double rf,af; int n,j,k,niter,i,m,l; /*Define various things*/ n=(int)*pn; m=(int)*pm; niter=*pniter; maxdelta=*pmaxdelta; volume=*pvolume; coolexp=*pcoolexp; repulserad=*prepulserad; frk=sqrt(volume/(double)n); /*Define the F-R constant*/ /*Allocate memory for transient structures*/ dx=(double *)R_alloc(n,sizeof(double)); dy=(double *)R_alloc(n,sizeof(double)); /*Run the annealing loop*/ for(i=niter;i>=0;i--){ /*Set the temperature (maximum move/iteration)*/ t=maxdelta*pow(i/(double)niter,coolexp); /*Clear the deltas*/ for(j=0;jt){ /*Dampen to t*/ ded=t/ded; dx[j]*=ded; dy[j]*=ded; } x[j]+=dx[j]; /*Update positions*/ y[j]+=dy[j]; } } } void gplot_layout_kamadakawai_R(int *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y) { double initemp,coolexp,sigma,temp,candx,candy; double dpot,odis,ndis,osqd,nsqd,kkconst; int niter,n,i,j,k; /*Define various things*/ n=(int)*pn; niter=*pniter; initemp=*pinitemp; coolexp=*pcoolexp; kkconst=*pkkconst; sigma=*psigma; GetRNGstate(); /*Get the RNG state*/ /*Perform the annealing loop*/ temp=initemp; for(i=0;i=2.0*M_PI) /*Map to [0,2pi) interval*/ c-=2.0*M_PI; while(c<0.0) c+=2.0*M_PI; /*Calculate the potential difference for the new position*/ dpot=0.0; for(k=0;k1.0){ /*Penalize edge crossings*/ for(m=0;m0)&&(d[k+j*n]>0)) && ((d[l+m*n]>0)&&(d[m+l*n]>0))){ opot=(double)poledgecross(radii[j],theta[j], radii[k],theta[k], radii[l],theta[l], radii[m],theta[m]); npot=(double)poledgecross(radii[j],c, radii[k],theta[k], radii[l],theta[l], radii[m],theta[m]); dpot+=crossconst*(opot-npot); /*Smaller is better*/ } }else{ /*Repel j from reciprocated, core edges*/ if((j!=l)&&(k!=l)&&(k!=l) && core[l] && ((d[k+l*n]>0)&&(d[l+k*n]>0))){ /*Calculate old potential*/ odjk=poldist(radii[j],theta[j],radii[k],theta[k]); odjl=poldist(radii[j],theta[j],radii[l],theta[l]); odjekl=pollinedist(radii[j],theta[j], radii[k],theta[k],radii[l],theta[l]); if((odjekl<=odjk)&&(odjekl<=odjl)) opot=repconst/(odjekl*odjekl); else opot=0.0; /*Calculate new potential*/ ndjk=poldist(radii[j],c,radii[k],theta[k]); ndjl=poldist(radii[j],c,radii[l],theta[l]); ndjekl=pollinedist(radii[j],c, radii[k],theta[k],radii[l],theta[l]); if((ndjekl<=ndjk)&&(ndjekl<=ndjl)) npot=repconst/(ndjekl*ndjekl); else npot=0.0; /*Add difference*/ dpot+=(opot-npot)/temp; /*Smaller is better*/ } } } /*Make a keep/reject decision*/ if(log(runif(0.0,1.0))=2.0*M_PI) /*Map to [0,2pi) interval*/ c-=2.0*M_PI; while(c<0.0) c+=2.0*M_PI; /*Calculate the potential difference for the new position*/ dpot=0.0; for(k=0;k0)||(d[l+k*n]>0))){ /*Calculate old potential*/ odjk=poldist(radii[j],theta[j],radii[k],theta[k]); odjl=poldist(radii[j],theta[j],radii[l],theta[l]); odjekl=pollinedist(radii[j],theta[j], radii[k],theta[k],radii[l],theta[l]); if((odjekl=2.0*M_PI) /*Map to [0,2pi) interval*/ c-=2.0*M_PI; while(c<0.0) c+=2.0*M_PI; /*Calculate the potential difference for the new position*/ dpot=0.0; for(k=0;k0)||(d[k+j*n]>0)){ odis=poldist(radii[j],theta[j],radii[k],theta[k]); ndis=poldist(radii[j],c,radii[k],theta[k]); osqd=odis*odis; nsqd=ndis*ndis; dpot+=nsqd-odis; } /*Edge repulsion potential*/ for(l=0;l0)||(d[l+k*n]>0))){ /*Calculate old potential*/ odjk=poldist(radii[j],theta[j],radii[k],theta[k]); odjl=poldist(radii[j],theta[j],radii[l],theta[l]); odjekl=pollinedist(radii[j],theta[j], radii[k],theta[k],radii[l],theta[l]); if((odjekl=0;i--){ /*Set the temperature (maximum move/iteration)*/ t=maxdelta*pow(i/(double)niter,coolexp); /*Clear the deltas*/ for(j=0;jt){ /*Dampen to t*/ ded=t/ded; dx[j]*=ded; dy[j]*=ded; dz[j]*=ded; } x[j]+=dx[j]; /*Update positions*/ y[j]+=dy[j]; z[j]+=dz[j]; } } } void gplot3d_layout_kamadakawai_R(double *pn, int *pniter, double *elen, double *pinitemp, double *pcoolexp, double *pkkconst, double *psigma, double *x, double *y, double *z) { double initemp,coolexp,sigma,temp,cx,cy,cz; double dpot,odis,ndis,osqd,nsqd,kkconst; int niter; long int n,i,j,k; /*Define various things*/ n=(long int)*pn; niter=*pniter; initemp=*pinitemp; coolexp=*pcoolexp; kkconst=*pkkconst; sigma=*psigma; GetRNGstate(); /*Get the RNG state*/ /*Perform the annealing loop*/ temp=initemp; for(i=0;i3.0 [submitted by Gen Kobayashi] Changes: Per request from CRAN, the non-standard CONTRIBUTORS file has been removed. Major contributors are cited on the respective man pages, and minor contributors (e.g., of bug fixes) in this ChangeLog. If there is strong interest in bringing the file back (I had no desire to pull it!), please email me and I'll see what can be done v2.3 Bug Fixes: Various changes to R caused installation and loading problems (including invocation of the help browser on load) that have been fixed Changes: gtrans now attempts to perform reasonable triage when use.adjacency==TRUE; specifically, if it can easily identify the input data type, it will override the use of the adjacency method for cases in which its use would obviously be a very bad idea. This will have no effect for those with smaller graphs, or who use use.adjacency==FALSE, but will improve performance for those with large, sparse graphs who never got around to noticing the use.adjacency argument as.edgelist.sna uses new network package coercion option, the main effect of which is to ensure that missingness is preserved during coercion; previously, this information was lost (not exactly a bug, but an unfortunate and sometimes unexpected consequence of the way that the network package handled edgelist coercion and the fact that sna relied on it); network v1.7 or later is required for this functionality, with old behavior preserved for network <=v1.6 gplot now uses 50-sided vertices by default (except for two-mode data, which now by default uses a combination of 4 and 50 sided vertices gplot now uses edge line types to alter the way lines are drawn rather than borders, as before) [contributed by Alex Montgomery] gplot now automagically scales objects based on the number of vertices in the graph New Functions: is.edgelist.sna - Check to see if a given object is an sna edgelist New Features: gplot now supports a feature (vertex.enclose) to enclose vertices within circles for greater visibility [contributed by Alex Montgomery] gplot now supports an argument (thresh.absval) to control whether edge values are thresholded by absolute (default) or signed value gplot now allows edge border line types to be set differently for positive and negative edges [contributed by Alex Montgomery] grecip now supports a correlation-based measure inspired by the work of David Dekker gtrans now supports rank-order and correlation-based measures for valued data (the last implementing a proposal of David Dekker) v2.2 - Changes and Bug Fixes Changes: as.sociomatrix.sna should now handle the new network edgelist format more gracefully; note, however, that edgelists for undirected graphs are still handled differently in network and sna, so one is usually better off coercing directly with as.edgelist.sna, rather than first going through as.matrix geodist now uses memory more efficiently, and should perform better on large graphs gplot now has some refinements to the placement of curved edges and to arrow widths [contibuted by Alex Montgomery] gplot.layout.fruchtermanreingold now uses an approximating backend (ported from network) which can greatly reduce layout time in large graphs (at some aesthetic cost); traditional results can still be obtained by appropriate choice of layout parameters Bug Fixes: cutpoints failed with connected="strong" when called with a graph containing loops [Submitted by Ben Madin] gden could return twice the density when called with mode="graph" [Submitted by Zack Almquist] gvectorize was censoring the upper triangle when called with censor.as.na=FALSE and mode="digraph" [Submitted by Zack Almquist] v2.1 - New Features, Changes, and Bug Fixes Changes: as.sociomatrix.sna and as.edgelist.sna are now treated as user-level functions (and are documented as such) betweenness and closeness now consistently enforce undirected behavior with gmode=="graph" (this will not generally be visible to the end user) connectedness now uses sparse graph methods (and is much, much faster) gplot now defaults to boxed.labels=FALSE rgbn now uses (and enforces) finite maxiter values New Features: evcent now allows user control over the number of iterations used in the internal eigenvector calculation (previously fixed), and supports an option for calculation using R's eigen() routine Bug Fixes: betweenness was not treating gmode=="graph" consistently with tmaxdev in both states (causing inaccurate centralization results) [Submitted by Natalie Cotton] brokerage.Rd would produce an installation error on some platforms for unknown reasons (seems to be an R issue, but man page formatting has been changed to be rid of it) bicomponent.dist was failing on very large graphs gplot was not plotting label positions correctly for pos=5; also fixed a bug with interactive selection by component [Fix by Alex Montgomery] kcores processed ignore.eval incorrectly [Submitted by mpezz@tiscali.it] redist failed when called with a single graph and mode="graph" [Submitted by Greg Bigwood] v2.0 - New Functions, New Data Sets, New Features, Changes, and Bug Fixes Changes: The following functions now natively use sna edgelist format (and will in most cases benefit from being passed data in sparse graph format): add.isolates, betweenness, brokerage, centralization, closeness, degree, dyad.census, evcent, gden, geodist, gplot, gplot3d, grecip, gtrans, kcycle.census, kpath.census, rgraph, stresscent, symmetrize, triad.census Various backend modifications have been made which should improve scalability and performance for many routines bbnam routines now default to often-realistic informative priors rather than to never-realistic uninformative ones, and no longer randomly reorder MCMC draws on output; they can also accept data in a wider range of formats bbnam.bf now computes and displays results in log scale centralization will now compute scores for all input networks (previously computed scores for only one network, so this may break some code) degree with gmode=="graph" now forces conventional graph theoretic degree, as opposed to total degree (which was the prior default behavior). This may break some existing code (but hopefully not much), but produces more conventional behavior in the undirected case. Users desiring the old behavior can obtain it by simply setting gmode=="digraph". [Suggested by Alex Montgomery] evcent now uses a sparse matrix eigenvector calculation mechanism (which should greatly enhance scalability) gplot's label placement algorithm has been improved [Submitted by Alex Montgomery] gden now omits NA edges (previously, they were treated as simply absent) gplot and gplot3d now pass edgelists to the gplot.layout.* and gplot3d.layout.* functions; all existing layout functions have been modified to support this, but user-generated code may need to be adjusted accordingly gplot and gplot3d now force data into two-mode form when gmode="twomode", regardless of original type; by default, vertex color (and, in gplot, shape) are used to differentiate between row and column vertices. [Submitted by Alex Montgomery] gplot.layout.fruchtermanreingold and gplot.layout.kamadakawai now use edge values when placing points rgbn has a new (much faster) backend implementation rgraph now uses an accelerated generation mechanism in the homogeneous case New Functions: as.edgelist.sna - Convert data to sna edgelist format bicomponent.dist - Compute bicomponents and associated statistics cug.test - Simplified univariate conditional uniform graph tests cutpoints - Identify cutpoints in an input graph clique.census - Calculate the clique census of an input graph flowbet - Calculate the flow betweenness scores of network positions gt - "Graph transpose"; transposition of one or more networks kcores - Calculate the k-core decomposition of a graph loadcent - Calculate the load centrality scores of network positions maxflow - Calculate maximum flows between vertices redist - Find distances between positions based on regular equivalence rgnmix - Generate mixing-conditioned random graphs New Data Sets: coleman - Coleman's high school friendship data New Features: New sna edgelist format now supported by almost all routines (see above for list of those which now have native support) Bipartite extension to adjacency structures now supported for most sna routines Several functions now have the option to return their results in sna edgelist format (useful to avoid adjacency matrix conversion for large graphs). These include add.isolates, read.nos, rewire.ud, rewire.ws, rgbn, rgnm, rgraph, rguman, rgws, and symmetrize. as.sociomatrix.sna - now supports force.bipartite, bipartite attribute betweenness now has an option to use edge values when computing geodesics; several alternative measures have also been added bn now takes lists of networks closeness now has an option to use edge values when computing geodesics; an alternative measure has also been added degree now has an option to ignore edge values gden now has an option to ignore edge values geodist now supports valued edges; an option has been added to return predecessor lists gplot now has an option ("interact.bycomp") to interactively move entire components (instead of individual vertices) [Submitted by Alex Montgomery] grecip now supports an additional index netlm now supports use of t-statistics for resampling tests (new default) rgbn supports a new exact sampling method stresscent now has an option to use edge values when computing geodesics Bug Fixes: rgbn was returning a redundant state v1.5 - New Functions, Changes, and Bug Fixes New Functions: component.largest - Extract the largest component from a graph kcycle.census - Compute cycle census information for a graph kpath.census - Compute path census information for a graph Changes: as.sociomatrix.sna now supports sparse matrices from the SparseM package (assuming that said package is installed); such objects should now be transparently supported by sna routines (albeit not efficiently) Bug Fixes: An error in the Holland and Leinhardt citation in the dyad.census documentation has been fixed [submitted by Ben Lind] Disabled lnam example which was apparently taking a long time to run on the CRAN test systems (but not on mine, for some reason) v1.4 - New Functions, Changes, and Bug Fixes New Functions: nacf - Network autocorrelation function neighborhood - Return the matrix of n-th order neighbors for an input graph Bug Fixes: Likelihood computation in lnam was innaccurate in some cases [submitted by Eric Neuman] Changes: A few remaining mva references were purged (see changes for v1.3) lnam has been rewritten using a different optimization scheme; this should prove more robust in some cases, but does change certain command-line arguments (see the man page for details) v1.3 - New Features, Changes, and Bug Fixes New Features: lnam now allows the user to specify multiple AR and/or MA effects simultaneously; network objects are also supported Changes: R version 2.0.0 is now required, due to the fact that mva has been phased out, mva was required for earlier R versions, and R CMD check now requires that any such package be mentioned on the "suggests" line of DESCRIPTION (thus generating an error, since mva is defunct). My apologies to anyone out there who is clinging to 1.x for some reason; I'd have left the support in, if that were feasible gplot and gplot3d now have displaylabels set to !missing(label) by default; this eliminates the need to manually set displaylabels when labels are explicitly specified [suggested by Gabor Grothendieck] Bug Fixes: ask=TRUE changed to ask=dev.interactive() where applicable, to ensure support for non-interactive devices [submitted by Kurt Hornik] network has been added to "suggests" line in DESCRIPTION, to calm down R check; it is helpful, but not essential v1.2 - New Functions, Changes, and Bug Fixes New Functions: ego.extract - Extract egocentric networks from complete network data Changes: Added a small tweak which improves performance of Romney-Batchelder model (consensus) where corner solutions are initially obtained for competency scores brokerage has now been backended, with substantial performance gains New backend functionality has been added for faster/more efficient graph storage; this is not user-visible, but will eventually result in better performance for many current routines (as it becomes integrated into the underlying code) Bug Fixes: Man page for components erroneously referred to the symmetrize function in place of component.dist Removed an errant two-parameter atan reference which was broken by changes in R >= 2.3 v1.1 - New Functions, New Features, and Bug Fixes New Functions: brokerage, summary.brokerage, print.summary.brokerage - Perform a Gould- Fernandez brokerage analysis read.dot - Read data in DOT format New Features: The variant of the Romney-Batchelder model implemented by consensus was not standard; consensus now also supports the canonical version. (Ironically, this variant seems slightly less effective, but is compatible with the multinomial processing tree interpretation.) Bug Fixes: equiv.clust and sedist would fail with multiple graphs if g argument was not explicitly set [submitted by Kieran Healy] triad.classify was not returning the right values in certain cases v1.0 - New Functions, New Features, Changes, and Bug Fixes New Functions: bn.* - Estimation for biased net models print.equiv.clust - Printing for equiv.clust objects rgbn - Draw from a biased net model structure.statistics - Return the structure statistics for one or more graphs write.dl - Write output in DL format write.nos - Write output in NOS format New Features: Most functions now support networks objects (a la the network package) and graph lists in a sensible way blockmodel now takes hclust objects or block membership vectors as input consensus now supports iterative reweighting (Romney-Batchelder model) equiv.clust now supports user-supplied distance matrices plot.sociomatrix can now suppress cell borders, and supports scaling of label text [latter suggested by Mark Handcock] triad.census and triad.classify now can now be set to obtain undirected triad classifications using mode="graph" Changes addisolates is now defunct (was deprecated - use add.isolates instead) grecip's output was confusing (edgewise measure was not what one might expect). grecip now gives a more conventional edgewise measure, with the old measure available as "dyadic.nonnull". [suggested by Simone Gabbriellini] netlm now uses more refined null hypotheses, and has been internally streamlined; output has been modified slightly. Modifications include the use of Dekker et al.'s semi-partialling procedure as the QAP default, and explicit compution of two-sided tests. netlogit has been changed in a manner analogous to netlm. Bug Fixes bbnam plot methods were creating ugly labels/titles equiv.clust and plot.equiv.clust were not fully compatible with recent changes in hclust gplot3d.arrow and gplot3d.loop (and hence gplot3d) were not drawing edge attributes properly print.blockmodel was failing under certain circumstances gtrans was producing inaccurate results on some graphs [submitted by Jessica Flack] plot.sociomatrix was generating annoying (albeit harmless) warning messages sedist was not considering all edges for mode=="graph" [submitted by Alex Montgomery] v0.51 - New Features and Bug Fixes New Features: gplot now supports vertex rotation, more refined label placement, and improved loop positioning [submitted by Alex Montgomery] gplot.layout.fruchtermanreingold, gplot.layout.kamadakawai, and their three-dimensional counterparts now accept "seed" coordinates through layout.par [suggested by Alex Montgomery] Bug Fixes: efficiency was producing incorrect values on some graphs options()$expression was limiting the number of vertex relocations in gplot's interactive mode gplot3d was not returning z coordinate [submitted by Alex Montgomery] v0.5 - New Functions, Changes, and Bug Fixes New Functions: gplot.arrow - Custom arrow-drawing for gplot gplot.layout.fruchtermanreingold - New layout method gplot.layout.hall - New layout method gplot.layout.kamadakawai - New layout method gplot.layout.target - New layout method gplot.loop - Custom loop-drawing for gplot gplot.target - Draw "target diagrams" using gplot gplot3d - Three-dimensional graph visualization gplot3d.arrow - Draw three-dimensional "arrows" gplot3d.layout.* - Layout functions for gplot3d gplot3d.loop - Draw three-dimensional "loops" is.connected - Determine whether or not one or more graphs is connected rgmn - Draw from the G(N,M) graph distribution rguman - Draw from the U|MAN graph distribution Changes: addisolates has been changed to add.isolates; addisolates is deprecated geodist now uses Inf as the default inf.replace value (was N); note that this may affect the default behavior of routines which use geodesic distance matrices on disconnected graphs gplot overhaul continues: gplot aspect ratio now fixed at 1:1 gplot now uses Fruchterman-Reingold as its default layout method gplot now supports manual setting of plot limits gplot now uses red as the default vertex color All plotting elements are now polygons; scaling is now performed relative to fractions of the plotting region, and all elements can be scaled. Labels are no longer plotted by default (and can be switched off with displaylabels) Various other minor changes have been made; see ?gplot Many routines (e.g., triad.classify, triad.census, geodist, etc.) now have C backends. This results in a tremendous performance boost (e.g., 1-2 orders of magnitude) on large graphs. Package code has been substantially reorganized A cumulative list of contributors has been added to the package -- see the CONTRIBUTORS file Bug Fixes betweenness no longer produces NaNs on disconnected vertex sets lubness was producing incorrect values for some graphs v0.44 - New Functions, New Features, Changes, and Bug Fixes New Functions: %c% - Composition of two adjacency matrices gapply - Apply functions over vertex neighborhoods. gplot.layout.* - Layout functions for gplot lnam - Fit a linear network autocorrelation model plot.lnam - Plotting for lnam objects print.lnam - Printing for lnam objects print.summary.lnam - Printing for lnam summary objects summary.lnam - Detailed printing for lnam objects New Features: consensus now supports union/intersection LAS and column/row raw report methods (useful for replicating "classic" CSS work) gplot sports a wide range of new features, including: An interactive mode, which allows for manual repositioning of vertices. (It's not pretty, but it works.) Silent return of the x,y coordinates for all vertices. This is useful for adding features to an existing plot, or for saving a given layout for later reuse. Adjacency matrices can now be used as parameters to set edge widths, line types, and colors [submitted by Alex Montgomery] Overplotting support [submitted by Alex Montgomery] Support for loops (i.e., self-ties) [submitted by Alex Montgomery] Curved edges, with adjustable curvature [submitted by Alex Montgomery] Support for user-supplied layout methods Expansion of existing layout methods, including new arguments Changes: triad.census now automatically removes the diagonal before calculating the triad census; a note on valued/unvalued data has also been added to the man page [suggested by Skye Bender-deMoll and Dan McFarland] Vertex layouts for gplot are now generated externally, via the gplot.layout.* functions. Arbitrary parameters may be passed to the layout functions via an argument list; further, since layout functions are identified with match.fun(), user-added functions can also be employed. The default layout method is now segeo (spring embedder results were sometimes very good, but too uneven). Bug Fixes: degree was reporting incorrect tmaxdev values in some cases triad.classify switched 111D and 111U [submitted by Dan McFarland and Skye Bender-deMoll] v0.43 - Minor Changes, Updates, and New Features Changes: Contact URL has been updated Updates: In keeping with the new rigorousness regarding data.frame structures in 1.8.0, many data.frames have been changed to lists. This should be transparent to the end user, but will avoid the generation of errors under the new system. Removed references to (deprecated) plot.hclust New Features: gplot now supports spring embedding. Providing unsupported layout modes now produces an error, rather than undefined behavior (as before). Options have also been added for suppressing the printing of axes, and for placing opaque boxes behind vertex labels. v0.42 - Minor Changes Changes: Author contact information has been updated plot.matrix is now plot.sociomatrix, in order to ensure compatibility with the new method standards; all code should be updated to reflect this fact v0.41 - Updates, New Features, and Bug Fixes Updates: Deprecated function .Alias removed (was used in netlm, netlogit) Changed keyword "network" to "math" in all help pages [as requested by the Keepers of R] Various internal changes to plot/print/summary methods, in order to maintain consistency with their generic equivalents; these will (hopefully) have no visible effect New Features: component.dist now supports weak, unilateral, strong, and recursive component definitions Bug Fixes: component.dist was calculating recursively connected components for connected="strong", instead of strongly connected components pstar was dumping (internal) edge perturbation data to the screen, which was harmless but very annoying; names for pstar coefficients were not being recognized by glm v0.4 - New Features, Changes, and Fixes New Functions: connectedness - Find the Krackhardt connectedness of a graph or graph stack dyad.census - Compute the Holland and Leinhardt MAN dyad census for a graph or graph stack efficiency - Find the Krackhardt efficiency of a graph or graph stack hierarchy - Find the hierarchy score of a graph or graph stack. infocent - Find the information centrality scores of network positions [submitted by David Barron] lubness - Find Krackhardt's Least Upper Boundedness of a graph or graph stack reachability - Find the reachability matrix of a graph. triad.census - Conduct a Davis and Leinhardt triad census for a graph or graph stack triad.classify - Return the Davis and Leinhardt classification of a given triad New Features: gplot now adjusts line width for valued graphs, via the edge.lwd parameter, and allows users to set the vertex point type (using vertex.pch. gmode=="graph" now sets usearrows<-FALSE, and new gmode "twomode" automagically plots two-mode data. New display modes have also been added: geodist (MDS of proximities); adj (MDS with adjacency as similarity); and seham (MDS of SE dist using Hamming method). grecip now supports a "measure" option, which allows the user to choose between "dyadic" reciprocity (aRb iff bRa) and "edgewise" reciprocity (aRb if bRa). The old version (and default) is the "dyadic" option, which (as the above implies) takes null dyads into account; the "edgewise" definition omits null dyads from the calculation. gtrans now supports a "measure" option, which allows the user to choose between "weak" transitivity (aRc if aRb & bRc) and "strong" transitivity (aRc iff aRb & bRc). The old version was strong-only, but much of the field prefers the weak version. Each of these options has a respective census variant ("weakcensus", "strongcensus") which returns a count of legal triads rather than a rate. pstar now supports separate options for strong/weak transitivity scores, and for strong/weak transitive triad counts. Bug Fixes: Labeling optimizers were not pre-sorting to guard against mixed-up exchange lists (these are now checked, too). Various centrality measures were not returning the correct absolute maximum deviation with tmaxdev==TRUE. gtrans was ignoring settings and counting diagonal entries [submitted by David Barron] pstar behaved badly when external predictors were unnamed [submitted by Gindo Tampubolon] Changes: Comparable labelings are now _enforced_ where applicable. lab.optimize.gumbel now just tries to scare you off, rather than refusing you altogether. Path-based indices (betweenness, closeness, stresscent, graphcent, etc.) now automatically assume cmode=="undirected" whenever gmode="graph". The default mode for gtrans is now "weak", to match the usage of W&F v0.3 - New Features, Changes, and Fixes General: All standard functions are now documented R package format is now supported New Functions: component.dist - Find the distribution of (maximal) component sizes within a graph components - Find the number of (maximal) components within a given graph eval.edgeperturbation - Evaluate a function on a given graph with and without a given edge, returning the difference between the results in each case. interval.graph - Construct one or more interval graphs (and exchangeability vectors) from a set of spells mutuality - Find the number of mutual (i.e., reciprocated) edges in a graph gscor - Computes the structural correlation between graphs gscov - Computes the structural covariance between graphs gtrans - Compute the transitivity of an input graph or graph stack. lab.optimize - Optimize a bivariate graph statistic over a set of labelings pstar - Fits a p* model using the logistic regression approximation read.nos - Reads input files in Neo-OrgStat format rperm - Draw a random permutation vector with exchangability constraints Features and Modifications: diag.remove, upper.tri.remove, and lower.tri.remove now allow replacement with any value gplot now provides a slew of new parameters to change color, size, etc. of vertices, edges, and labels gscor and gscov now delegate to lab.optimize gscor, gscov, structdist now support exchange lists (via lab.optimize) v0.2 - New Features and Some Bug Fixes New Functions: blockmodel - Generate blockmodels based on partitions of network positions blockmodel.expand - Generate a graph from a given blockmodel using particular expansion rules bonpow - Find the Bonacich power centrality scores of network positions equiv.clust - Find clusters of positions based on an equivalence relation evcent - Find the eigenvector centralities of network positions gdist.plotdiff - Plot differences in graph-level statistics against inter-graph distances gdist.plotstats - Plot statistics associated with graphs against (projected) inter-graph distances make.stochastic - Make a graph stack row, column, or row-column stochastic plot.blockmodel - Plotting for blockmodel objects plot.equiv.clust - Plotting for equivalence clustering objects prestige - Find actor prestige scores from one of several measures print.blockmodel - Printing for blockmodel objects print.summary.blockmodel - Printing for blockmodel summary objects sedist - Find distances between positions based on structural equivalence stackcount -Find the number of matrices in a graph stack (matrix or array data acceptable) summary.blockmodel - Detailed printing for blockmodel objects Features and Modifications: All centrality routines can now be rescaled (division by maximum realized value); default is always FALSE Bug Fixes: Various centrality routines once again return values for the selected graph and vertices sna/NAMESPACE0000644000176200001440000000367513573632603012275 0ustar liggesusers# Import all packages listed as Imports or Depends import( utils, statnet.common, network, stats, graphics ) importFrom("grDevices", "dev.interactive", "gray") # Export everything but the %c% operators exportPattern("^[^%]") export('%c%.matrix') # I think this is missed by the pattern above S3method(as.edgelist,sna) S3method('%c%','matrix') S3method(coef,bn) S3method(coef,lnam) S3method(plot,bbnam) S3method(plot,bbnam.actor) S3method(plot,bbnam.fixed ) S3method(plot,bbnam.pooled) S3method(plot,blockmodel ) S3method(plot,bn) S3method(plot,cug.test ) S3method(plot,cugtest ) S3method(plot,equiv.clust ) S3method(plot,lnam ) S3method(plot,qaptest) S3method(plot,sociomatrix ) S3method(print,bayes.factor ) S3method(print,bbnam ) S3method(print,bbnam.actor) S3method(print,bbnam.fixed ) S3method(print,bbnam.pooled ) S3method(print,blockmodel ) S3method(print,bn) S3method(print,cug.test ) S3method(print,cugtest ) S3method(print,equiv.clust ) S3method(print,lnam) S3method(print,netcancor ) S3method(print,netlm ) S3method(print,netlogit ) S3method(print,qaptest) S3method(print,summary.bayes.factor ) S3method(print,summary.bbnam) S3method(print,summary.bbnam.actor ) S3method(print,summary.bbnam.fixed) S3method(print,summary.bbnam.pooled ) S3method(print,summary.blockmodel ) S3method(print,summary.bn) S3method(print,summary.brokerage ) S3method(print,summary.cugtest ) S3method(print,summary.lnam) S3method(print,summary.netcancor ) S3method(print,summary.netlm ) S3method(print,summary.netlogit) S3method(print,summary.qaptest ) S3method(summary,bayes.factor ) S3method(summary,bbnam) S3method(summary,bbnam.actor ) S3method(summary,bbnam.fixed ) S3method(summary,bbnam.pooled) S3method(summary,blockmodel ) S3method(summary,bn ) S3method(summary,brokerage ) S3method(summary,cugtest) S3method(summary,lnam ) S3method(summary,netcancor ) S3method(summary,netlm ) S3method(summary,netlogit) S3method(summary,qaptest) useDynLib(sna, .registration = TRUE) sna/man/0000755000176200001440000000000014667252374011626 5ustar liggesuserssna/man/summary.blockmodel.Rd0000644000176200001440000000142311176706361015714 0ustar liggesusers\name{summary.blockmodel} \alias{summary.blockmodel} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of blockmodel Objects } \description{ Returns a \code{blockmodel} summary object. } \usage{ \method{summary}{blockmodel}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{blockmodel} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ % %} \value{ An object of class \code{summary.blockmodel} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{blockmodel}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/geodist.Rd0000644000176200001440000000634213573640243013547 0ustar liggesusers\name{geodist} \alias{geodist} \alias{geodist_R} \alias{geodist_adj_R} \alias{geodist_val_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Fund the Numbers and Lengths of Geodesics Among Nodes in a Graph } \description{ \code{geodist} uses a BFS to find the number and lengths of geodesics between all nodes of \code{dat}. Where geodesics do not exist, the value in \code{inf.replace} is substituted for the distance in question. } \usage{ geodist(dat, inf.replace=Inf, count.paths=TRUE, predecessors=FALSE, ignore.eval=TRUE, na.omit=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{inf.replace}{ the value to use for geodesic distances between disconnected nodes; by default, this is equal \code{Inf}. } \item{count.paths}{ logical; should a count of geodesics be included in the returned object?} \item{predecessors}{ logical; should a predecessor list be included in the returned object?} \item{ignore.eval}{ logical; should edge values be ignored when computing geodesics?} \item{na.omit}{ logical; should \code{NA}-valued edges be removed?} } \details{ This routine is used by a variety of other functions; many of these will allow the user to provide manually precomputed \code{geodist} output so as to prevent expensive recomputation. Note that the choice of infinite path length for disconnected vertex pairs is non-canonical (albeit common), and some may prefer to simply treat these as missing values. \code{geodist} (without loss of generality) treats all paths as directed, a fact which should be kept in mind when interpreting \code{geodist} output. By default, \code{geodist} ignores edge values (except for \code{NA}ed edges, which are dropped when \code{na.omit==TRUE}). Setting \code{ignore.eval=FALSE} will change this behavior, with edge values being interpreted as distances; where edge values reflect proximity or tie strength, transformation may be necessary. Edge values should also be non-negative. Because the valued-case algorithm is significantly slower than the unvalued-case algorithm, \code{ignore.eval} should be set to \code{TRUE} wherever possible. } \value{ A list containing: \item{counts}{If \code{count.paths==TRUE}, a matrix containing the number of geodesics between each pair of vertices} \item{gdist}{A matrix containing the geodesic distances between each pair of vertices} \item{predecessors}{If \code{predecessors}, a list whose ith element is a list of vectors, the jth of which contains the intervening vertices on all shortest paths from i to j} } \references{ Brandes, U. (2000). ``Faster Evaluation of Shortest-Path Based Centrality Indices.'' \emph{Konstanzer Schriften in Mathematik und Informatik}, 120. West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{component.dist}}, \code{\link{components}} } \examples{ #Find geodesics on a random graph gd<-geodist(rgraph(15)) #Examine the number of geodesics gd$counts #Examine the geodesic distances gd$gdist } \keyword{ graphs }%-- one or more ... \keyword{ math} sna/man/cug.test.Rd0000644000176200001440000000540611212675553013645 0ustar liggesusers\name{cug.test} \Rdversion{1.1} \alias{cug.test} \alias{plot.cug.test} \alias{print.cug.test} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Univariate Conditional Uniform Graph Tests } \description{ \code{cug.test} takes an input network and conducts a conditional uniform graph (CUG) test of the statistic in \code{FUN}, using the conditioning statistics in \code{cmode}. The resulting test object has custom print and plot methods. } \usage{ cug.test(dat, FUN, mode = c("digraph", "graph"), cmode = c("size", "edges", "dyad.census"), diag = FALSE, reps = 1000, ignore.eval = TRUE, FUN.args = list()) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{FUN}{ the function generating the test statistic; note that this must take a graph as its first argument, and return a single numerical value. } \item{mode}{ \code{graph} if \code{dat} is an undirected graph, else \code{digraph}. } \item{cmode}{ string indicating the type of conditioning to be applied. } \item{diag}{ logical; should self-ties be treated as valid data? } \item{reps}{ number of Monte Carlo replications to use. } \item{ignore.eval}{ logical; should edge values be ignored? (Note: \code{TRUE} is usually more efficient.) } \item{FUN.args}{ a list containing any additional arguments to \code{FUN}. } } \details{ \code{cug.test} is an improved version of \code{cugtest}, for use only with univariate CUG hypotheses. Depending on \code{cmode}, conditioning on the realized size, edge count (or exact edge value distribution), or dyad census (or dyad value distribution) can be selected. Edges are treated as unvalued unless \code{ignore.eval=FALSE}; since the latter setting is less efficient for sparse graphs, it should be used only when necessary. A brief summary of the theory and goals of conditional uniform graph testing can be found in the reference below. See also \code{\link{cugtest}} for a somewhat informal description. } \value{ An object of class \code{cug.test}. } \references{ Butts, Carter T. (2008). \dQuote{Social Networks: A Methodological Introduction.} \emph{Asian Journal of Social Psychology,} 11(1), 13--41. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{cugtest}} } \examples{ #Draw a highly reciprocal network g<-rguman(1,15,mut=0.25,asym=0.05,null=0.7) #Test transitivity against size, density, and the dyad census cug.test(g,gtrans,cmode="size") cug.test(g,gtrans,cmode="edges") cug.test(g,gtrans,cmode="dyad.census") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{htest} \keyword{ math } \keyword{ graphs } sna/man/gt.Rd0000644000176200001440000000316011176721575012523 0ustar liggesusers\name{gt} \Rdversion{1.1} \alias{gt} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Transpose an Input Graph } \description{ \code{gt} returns the graph transpose of its input. For an adjacency matrix, this is the same as using \code{\link{t}}; however, this function is also applicable to sna edgelists (which cannot be transposed in the usual fashion). Code written using \code{gt} instead of \code{t} is thus guaranteed to be safe for either form of input. } \usage{ gt(x, return.as.edgelist = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ one or more graphs. } \item{return.as.edgelist}{ logical; should the result be returned in sna edgelist form? } } \details{ The transpose of a (di)graph, \eqn{G=(V,E)}, is the graph \eqn{G=(V,E')} where \eqn{E'=\{(j,i): (i,j) \in E\}}{E'={(j,i): (i,j) in E}}. This is simply the graph formed by reversing the sense of the edges. } \value{ The transposed graph(s). } %\references{ %% ~put references to the literature/web site here ~ %} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{symmetrize}}, \code{\link{t}} } \examples{ #Create a graph.... g<-rgraph(5) g #Transpose it gt(g) gt(g)==t(g) #For adjacency matrices, same as t(g) #Now, see both versions in edgelist form as.edgelist.sna(g) gt(g,return.as.edgelist=TRUE) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ manip }% __ONLY ONE__ keyword per line sna/man/print.lnam.Rd0000644000176200001440000000165511176527723014201 0ustar liggesusers\name{print.lnam} \alias{print.lnam} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Printing for lnam Objects } \description{ Prints an objsect of class \code{lnam} } \usage{ \method{print}{lnam}(x, digits = max(3, getOption("digits") - 3), ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{lnam}. } \item{digits}{ number of digits to display. } \item{\dots}{ additional arguments. } } %\details{ % ~~ If necessary, more details than the __description__ above ~~ %} \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{lnam}} } %\examples{ %} \keyword{ print }% at least one, from doc/KEYWORDS %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line sna/man/summary.qaptest.Rd0000644000176200001440000000137511176706271015270 0ustar liggesusers\name{summary.qaptest} \alias{summary.qaptest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of qaptest Objects } \description{ Returns a \code{qaptest} summary object } \usage{ \method{summary}{qaptest}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{qaptest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ % %} \value{ An object of class \code{summary.qaptest} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{qaptest}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/make.stochastic.Rd0000644000176200001440000000446711176545105015175 0ustar liggesusers\name{make.stochastic} \alias{make.stochastic} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Make a Graph Stack Row, Column, or Row-column Stochastic } \description{ Returns a graph stack in which each adjacency matrix in \code{dat} has been normalized to row stochastic, column stochastic, or row-column stochastic form, as specified by \code{mode}. } \usage{ make.stochastic(dat, mode="rowcol", tol=0.005, maxiter=prod(dim(dat)) * 100, anneal.decay=0.01, errpow=1) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a collection of input graphs. } \item{mode}{ one of ``row,'' ``col,'' or ``rowcol''. } \item{tol}{ tolerance parameter for the row-column normalization algorithm. } \item{maxiter}{ maximum iterations for the rwo-column normalization algorithm. } \item{anneal.decay}{ probability decay factor for the row-column annealer. } \item{errpow}{ power to which absolute row-column normalization errors should be raised for the annealer (i.e., the penalty function). } } \details{ Row and column stochastic matrices are those whose rows and columns sum to 1 (respectively). These are quite straightforwardly produced here by dividing each row (or column) by its sum. Row-column stochastic matrices, by contrast, are those in which each row \emph{and} each column sums to 1. Here, we try to produce row-column stochastic matrices whose values are as close in proportion to the original data as possible by means of an annealing algorithm. This is probably not optimal in the long term, but the results seem to be consistent where row-column stochasticization of the original data is possible (which it is not in all cases). } \value{ The stochasticized adjacency matrices } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ } \section{Warning }{Rows or columns which sum to 0 in the original data will generate undefined results. This can happen if, for instance, your input graphs contain in- or out-isolates.} %\seealso{ } \examples{ #Generate a test matrix g<-rgraph(15) #Make it row stochastic make.stochastic(g,mode="row") #Make it column stochastic make.stochastic(g,mode="col") #(Try to) make it row-column stochastic make.stochastic(g,mode="rowcol") } \keyword{ manip } \keyword{ array } \keyword{ algebra }%-- one or more ... sna/man/gplot.vertex.Rd0000644000176200001440000000331510501711235014533 0ustar liggesusers\name{gplot.vertex} \alias{gplot.vertex} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Add Vertices to a Plot } \description{ \code{gplot.vertex} adds one or more vertices (drawn using \code{\link{polygon}}) to a plot. } \usage{ gplot.vertex(x, y, radius = 1, sides = 4, border = 1, col = 2, lty = NULL, rot = 0, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a vector of x coordinates. } \item{y}{ a vector of y coordinates. } \item{radius}{ a vector of vertex radii. } \item{sides}{ a vector containing the number of sides to draw for each vertex. } \item{border}{ a vector of vertex border colors. } \item{col}{ a vector of vertex interior colors. } \item{lty}{ a vector of vertex border line types. } \item{rot}{ a vector of vertex rotation angles (in degrees). } \item{\dots}{ Additional arguments to \code{\link{polygon}} } } \details{ \code{gplot.vertex} draws regular polygons of specified radius and number of sides, at the given coordinates. This is useful for routines such as \code{\link{gplot}}, which use such shapes to depict vertices. } \value{ None } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot}}, \code{\link{polygon}} } \examples{ #Open a plot window, and place some vertices plot(0,0,type="n",xlim=c(-1.5,1.5),ylim=c(-1.5,1.5),asp=1) gplot.vertex(cos((1:10)/10*2*pi),sin((1:10)/10*2*pi),col=1:10, sides=3:12,radius=0.1) } \keyword{ aplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/print.cugtest.Rd0000644000176200001440000000132311176542200014703 0ustar liggesusers\name{print.cugtest} \alias{print.cugtest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for cugtest Objects} \description{ Prints a quick summary of objects produced by \code{\link{cugtest}}. } \usage{ \method{print}{cugtest}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{cugtest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ None. } %\references{} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{cugtest}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/structure.statistics.Rd0000644000176200001440000000520710501711234016324 0ustar liggesusers\name{structure.statistics} \alias{structure.statistics} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute Network Structure Statistics } \description{ Computes the structure statistics for the graph(s) in \code{dat}. } \usage{ structure.statistics(dat, geodist.precomp = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{geodist.precomp}{ a \code{\link{geodist}} object (optional). } } \details{ Let \eqn{G=(V,E)} be a graph of order \eqn{N}, and let \eqn{d(i,j)} be the geodesic distance from vertex \eqn{i} to vertex \eqn{j} in \eqn{G}. The "structure statistics" of \eqn{G} are then given by the series \eqn{s_0,\ldots,s_{N-1}}, where \eqn{s_i = \frac{1}{N^2} \sum_{j \in V} \sum_{k \in V} I\left(d(j,k) \le i\right) }{s_i = sum(sum(I(d(j,k)<=i, k in V), j in V)/N^2} and \eqn{I} is the standard indicator function. Intuitively, \eqn{s_i} is the expected fraction of \eqn{G} which lies within distance \code{i} of a randomly chosen vertex. As such, the structure statistics provide an index of global connectivity. Structure statistics have been of particular importance to biased net theorists, because of the link with Rapoport's original tracing model. They may also be used along with component distributions or connectedness scores as descriptive indices of connectivity at the graph-level. } \value{ A vector, matrix, or list (depending on \code{dat}) containing the structure statistics. } \references{ Fararo, T.J. (1981). ``Biased networks and social structure theorems. Part I.'' \emph{Social Networks,} 3, 137-159. Fararo, T.J. (1984). ``Biased networks and social structure theorems. Part II.'' \emph{Social Networks,} 6, 223-258. Fararo, T.J. and Sunshine, M.H. (1964). ``A study of a biased friendship net.'' Syracuse, NY: Youth Development Center. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The term "structure statistics" has been used somewhat loosely in the literature, a trend which seems to be accelerating. Users should carefully check references before comparing results generated by this routine with those appearing in published work. } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{geodist}}, \code{\link{component.dist}}, \code{\link{connectedness}}, \code{\link{bn}} } \examples{ #Generate a moderately sparse Bernoulli graph g<-rgraph(100,tp=1.5/99) #Compute the structure statistics for g ss<-structure.statistics(g) plot(0:99,ss,xlab="Mean Coverage",ylab="Distance") } \keyword{ graphs }% at least one, from doc/KEYWORDS %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line sna/man/interval.graph.Rd0000644000176200001440000000726111176545331015035 0ustar liggesusers\name{interval.graph} \alias{interval.graph} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Convert Spell Data to Interval Graphs } \description{ Constructs one or more interval graphs (and exchangeability vectors) from a set of spells. } \usage{ interval.graph(slist, type="simple", diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{slist}{ A spell list. This must consist of an nxmx3 array, with n being the number of actors, m being the maximum number of spells (one per row) and with the three columns of the last dimension containing a (categorical) spell type code, the time of spell onset (any units), and the time of spell termination (same units), respectively. } \item{type}{ One of ``simple'', ``overlap'', ``fracxy'', ``fracyx'', or ``jntfrac''. } \item{diag}{ Include the dyadic entries? } } \details{ Given some ordering dimension T (usually time), a ``spell'' is defined as the interval between a specified onset and a specified termination (with onset preceding the termination). An interval graph, then, on spell set V, is \eqn{G=\{V,E\}}, where \eqn{\{i,j\} \in E}{\{i,j\} in E} iff there exists some point \eqn{t \in T}{e \in T} such that \eqn{t \in i}{t \in i} and \eqn{t \in j}{t \in j}. In more prosaic terms, an interval graph on a given spell set has each spell as a vertex, with vertices adjacent iff they overlap. Such structures are useful for quantifying life history data (where spells might represent marriages, periods of child custody/co-residence, periods of employment, etc.), organizational history data (where spells might reflect periods of strategic alliances, participation in a particular product market, etc.), task scheduling (with spells representing the dedication of a particular resource to a given task), etc. By giving complex historical data a graphic representation, it is possible to easily perform a range of analyses which would otherwise be difficult and/or impossible (see Butts and Pixley (2004) for examples). In addition to the simple interval graph (described above), \code{interval.graph} can also generate valued interval graphs using a number of different edge definitions. This is controlled by the \code{type} argument, with edge values as follows: \enumerate{ \item simple: dichotomous coding based on simple overlap (i.e., (x,y)=1 iff x overlaps y) \item overlap: edge value equals the total magnitude of the overlap between spells \item fracxy: the (x,y) edge value equals the fraction of the duration of y which is covered by x \item fracyx: the (x,y) edge value equals the fraction of the duration of x which is covered by y \item jntfrac: edge value equals the total magnitude of the overlap between spells divided by the mean of the spells' lengths } Note that ``simple,'' ``overlap,'' and ``jntfrac'' are symmetric relations, while ``fracxy'' and ``fracyx'' are directed. As always, the specific edge type used should reflect the application to which the interval graph is being put. } \value{ A data frame containing: \item{graph }{A graph stack containing the interval graphs} \item{exchange.list }{Matrix containing the vector of spell types associated with each interval graph} } \references{ Butts, C.T. and Pixley, J.E. (2004). ``A Structural Approach to the Representation of Life History Data.'' \emph{Journal of Mathematical Sociology}, 28(2), 81-124. West, D.B. (1996). \emph{Introduction to Graph Theory}. Upper Saddle River, NJ: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } %\examples{ %} \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/brokerage.Rd0000644000176200001440000001145713573635424014062 0ustar liggesusers\name{brokerage} \alias{brokerage} \alias{summary.brokerage} \alias{print.summary.brokerage} \alias{brokerage_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Perform a Gould-Fernandez Brokerage Analysis } \description{ Performs the brokerage analysis of Gould and Fernandez on one or more input graphs, given a class membership vector. } \usage{ brokerage(g, cl) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{g}{ one or more input graphs. } \item{cl}{ a vector of class memberships. } } \details{ Gould and Fernandez (following Marsden and others) describe \emph{brokerage} as the role played by a social actor who mediates contact between two alters. More formally, vertex \eqn{v} is a broker for distinct vertices \eqn{a} and \eqn{b} iff \eqn{a \to v \to b}{a -> v -> b} and \eqn{a \not\to b}{a -!> b}. Where actors belong to a priori distinct groups, group membership may be used to segment brokerage roles into particular types. Let \eqn{A \to B \to C}{A -> B -> C} denote the two-path associated with a brokerage structure, such that some vertex from group \eqn{B} brokers the connection from some vertex from group \eqn{A} to a vertex in group \eqn{C}. The types of brokerage roles defined by Gould and Fernandez (and their accompanying two-path structures) are then defined in terms of group membership as follows: \itemize{ \item \eqn{w_I}: Coordinator role; the broker mediates contact between two individuals from his or her own group. Two-path structure: \eqn{A \to A \to A}{A -> A -> A} \item \eqn{w_O}: Itinerant broker role; the broker mediates contact between two individuals from a single group to which he or she does not belong. Two-path structure: \eqn{A \to B \to A}{A -> B -> A} \item \eqn{b_{OI}}: Gatekeeper role; the broker mediates an incoming contact from an out-group member to an in-group member. Two-path structure: \eqn{A \to B \to B}{A -> B -> B} \item \eqn{b_{IO}}: Representative role; the broker mediates an outgoing contact from an in-group member to an out-group member. Two-path structure: \eqn{A \to A \to B}{A -> A -> B} \item \eqn{b_O}: Liaison role; the broker mediates contact between two individuals from different groups, neither of which is the group to which he or she belongs. Two-path structure: \eqn{A \to B \to C}{A -> B -> C} \item \eqn{t}: Total (cumulative) brokerage role occupancy. (Any of the above two-paths.) } The \emph{brokerage score} for a given vertex with respect to a given role is the number of ordered pairs having the appropriate group membership(s) brokered by said vertex. \code{brokerage} computes the brokerage scores for each vertex, given an input graph and vector of class memberships. Aggregate scores are also computed at the graph level, which correspond to the total frequency of each role type within the network structure. Expectations and variances of the brokerage scores conditional on size and density are computed, along with approximate \eqn{z}-tests for incidence of brokerage. (Note that the accuracy of the normality assumption is not known in the general case; see Gould and Fernandez (1989) for details. Simulation-based tests may be desirable as an alternative.) } \value{ An object of class \code{brokerage}, containing the following elements: \item{raw.nli }{The matrix of observed brokerage scores, by vertex} \item{exp.nli }{The matrix of expected brokerage scores, by vertex} \item{sd.nli }{The matrix of predicted brokerage score standard deviations, by vertex} \item{z.nli }{The matrix of standardized brokerage scores, by vertex} \item{raw.gli }{The vector of observed aggregate brokerage scores} \item{exp.gli }{The vector of expected aggregate brokerage scores} \item{sd.gli }{The vector of predicted aggregate brokerage score standard deviations} \item{z.gli }{The vector of standardized aggregate brokerage scores} \item{exp.grp }{The matrix of expected brokerage scores, by group} \item{sd.grp }{The matrix of predicted brokerage score standard deviations, by group} \item{cl }{The vector of class memberships} \item{clid }{The original class names} \item{n }{The input class sizes} \item{N }{The order of the input network} } \references{ Gould, R.V. and Fernandez, R.M. 1989. \dQuote{Structures of Mediation: A Formal Approach to Brokerage in Transaction Networks.} \emph{Sociological Methodology,} 19: 89-126. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ % % ~Make other sections like Warning with \section{Warning }{....} ~ %} \seealso{ \code{\link{triad.census}}, \code{\link{gtrans}} } \examples{ #Draw a random network with 3 groups g<-rgraph(15) cl<-rep(1:3,5) #Compute a brokerage object b<-brokerage(g,cl) summary(b) } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ models }% __ONLY ONE__ keyword per line sna/man/centralization.Rd0000644000176200001440000000651611176501162015133 0ustar liggesusers\name{centralization} \alias{centralization} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Centralization of a Given Network, for Some Measure of Centrality } \description{ \code{Centralization} returns the centralization GLI (graph-level index) for a given graph in \code{dat}, given a (node) centrality measure \code{FUN}. \code{Centralization} follows Freeman's (1979) generalized definition of network centralization, and can be used with any properly defined centrality measure. This measure must be implemented separately; see the references below for examples. } \usage{ centralization(dat, FUN, g=NULL, mode="digraph", diag=FALSE, normalize=TRUE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{FUN}{ Function to return nodal centrality scores.} \item{g}{ Integer indicating the index of the graph for which centralization should be computed. By default, all graphs are employed. } \item{mode}{ String indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } \item{diag}{ Boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{normalize}{ Boolean indicating whether or not the centralization score should be normalized to the theoretical maximum. (Note that this function relies on \code{FUN} to return this value when called with \code{tmaxdev==TRUE}.) By default, \code{tmaxdev==TRUE}. } \item{\dots}{ Additional arguments to \code{FUN}. } } \details{ The centralization of a graph G for centrality measure \eqn{C(v)}{C(v)} is defined (as per Freeman (1979)) to be: \deqn{C^*(G) = \sum_{i \in V(G)} \left|\max_{v \in V(G)}(C(v))-C(i)\right|}{% C^*(G) = sum( |max(C(v))-C(i)|, i in V(G) )} Or, equivalently, the absolute deviation from the maximum of C on G. Generally, this value is normalized by the theoretical maximum centralization score, conditional on \eqn{|V(G)|}{|V(G)|}. (Here, this functionality is activated by \code{normalize}.) \code{Centralization} depends on the function specified by \code{FUN} to return the vector of nodal centralities when called with \code{dat} and \code{g}, and to return the theoretical maximum value when called with the above and \code{tmaxdev==TRUE}. For an example of such a centrality routine, see \code{\link{degree}}. } \value{ The centralization of the specified graph. } \references{Freeman, L.C. (1979). ``Centrality in Social Networks I: Conceptual Clarification.'' \emph{Social Networks}, 1, 215-239. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ See \code{\link{cugtest}} for null hypothesis tests involving centralization scores. } \seealso{ \code{\link{cugtest}} } \examples{ #Generate some random graphs dat<-rgraph(5,10) #How centralized is the third one on indegree? centralization(dat,g=3,degree,cmode="indegree") #How about on total (Freeman) degree? centralization(dat,g=3,degree) } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/summary.cugtest.Rd0000644000176200001440000000137011176706350015256 0ustar liggesusers\name{summary.cugtest} \alias{summary.cugtest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of cugtest Objects } \description{ Returns a \code{cugtest} summary object } \usage{ \method{summary}{cugtest}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{cugtest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ % %} \value{ An object of class \code{summary.cugtest} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{cugtest}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/structdist.Rd0000644000176200001440000001631311361526035014313 0ustar liggesusers\name{structdist} \alias{structdist} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Structural Distances Between Two or More Graphs } \description{ \code{structdist} returns the structural distance between the labeled graphs \code{g1} and \code{g2} in stack \code{dat} based on Hamming distance for dichotomous data, or else the absolute (manhattan) distance. If \code{normalize} is true, this distance is divided by its dichotomous theoretical maximum (conditional on |V(G)|). } \usage{ structdist(dat, g1=NULL, g2=NULL, normalize=FALSE, diag=FALSE, mode="digraph", method="anneal", reps=1000, prob.init=0.9, prob.decay=0.85, freeze.time=25, full.neighborhood=TRUE, mut=0.05, pop=20, trials=5, exchange.list=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g1}{ a vector indicating which graphs to compare (by default, all elements of \code{dat}). } \item{g2}{ a vector indicating against which the graphs of \code{g1} should be compared (by default, all graphs). } \item{normalize}{ divide by the number of available dyads? } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default.} \item{method}{ method to be used to search the space of accessible permutations; must be one of \code{"none"}, \code{"exhaustive"}, \code{"anneal"}, \code{"hillclimb"}, or \code{"mc"}. } \item{reps}{ number of iterations for Monte Carlo method.} \item{prob.init}{ initial acceptance probability for the annealing routine. } \item{prob.decay}{ cooling multiplier for the annealing routine. } \item{freeze.time}{ freeze time for the annealing routine. } \item{full.neighborhood}{ should the annealer evaluate the full neighborhood of pair exchanges at each iteration? } \item{mut}{ GA Mutation rate (currently ignored). } \item{pop}{ GA population (currently ignored). } \item{trials}{ number of GA populations (currently ignored). } \item{exchange.list}{ information on which vertices are exchangeable (see below); this must be a single number, a vector of length n, or a nx2 matrix. } } \details{ The structural distance between two graphs G and H is defined as \deqn{d_S\left(G,H \left| L_G,L_H\right.\right) = \min_{L_G,L_H} d\left(\ell\left(G\right),\ell\left(H\right)\right)}{% d_S(G,H | L_G,L_H) = min_[L_G,L_H] d(l(G),l(H))} where \eqn{L_G} is the set of accessible permutations/labelings of G, and \eqn{\ell(G)}{l(G)} is a permuation/relabeling of the vertices of G (\eqn{\ell(G) \in L_G}{l(G) in L_G}). The set of accessible permutations on a given graph is determined by the \emph{theoretical exchangeability} of its vertices; in a nutshell, two vertices are considered to be theoretically exchangeable for a given problem if all predictions under the conditioning theory are invariant to a relabeling of the vertices in question (see Butts and Carley (2001) for a more formal exposition). Where no vertices are exchangeable, the structural distance becomes the its labeled counterpart (here, the Hamming distance). Where \emph{all} vertices are exchangeable, the structural distance reflects the distance between unlabeled graphs; other cases correspond to distance under partial labeling. The accessible permutation set is determined by the \code{exchange.list} argument, which is dealt with in the following manner. First, \code{exchange.list} is expanded to fill an nx2 matrix. If \code{exchange.list} is a single number, this is trivially accomplished by replication; if \code{exchange.list} is a vector of length n, the matrix is formed by \code{cbind}ing two copies together. If \code{exchange.list} is already an nx2 matrix, it is left as-is. Once the nx2 exchangeabiliy matrix has been formed, it is interpreted as follows: columns refer to graphs 1 and 2, respectively; rows refer to their corresponding vertices in the original adjacency matrices; and vertices are taken to be theoretically exchangeable iff their corresponding exchangeability matrix values are identical. To obtain an unlabeled distance (the default), then, one could simply let \code{exchange.list} equal any single number. To obtain the Hamming distance, one would use the vector \code{1:n}. Because the set of accessible permutations is, in general, very large (\eqn{o(n!)}), searching the set for the minimum distance is a non-trivial affair. Currently supported methods for estimating the structural distance are hill climbing, simulated annealing, blind monte carlo search, or exhaustive search (it is also possible to turn off searching entirely). Exhaustive search is not recommended for graphs larger than size 8 or so, and even this may take days; still, this is a valid alternative for small graphs. Blind monte carlo search and hill climbing tend to be suboptimal for this problem and are not, in general recommended, but they are available if desired. The preferred (and default) option for permutation search is simulated annealing, which seems to work well on this problem (though some tinkering with the annealing parameters may be needed in order to get optimal performance). See the help for \code{\link{lab.optimize}} for more information regarding these options. Structural distance matrices may be used in the same manner as any other distance matrices (e.g., with multidimensional scaling, cluster analysis, etc.) Classical null hypothesis tests should not be employed with structural distances, and QAP tests are almost never appropriate (save in the uniquely labeled case). See \code{\link{cugtest}} for a more reasonable alternative. } \value{ A structural distance matrix } \references{ Butts, C.T. and Carley, K.M. (2005). \dQuote{Some Simple Algorithms for Structural Comparison.} \emph{Computational and Mathematical Organization Theory,} 11(4), 291-305. Butts, C.T., and Carley, K.M. (2001). \dQuote{Multivariate Methods for Interstructural Analysis.} CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Consult Butts and Carley (2001) for advice and examples on theoretical exchangeability. } \section{Warning }{The search process can be \emph{very slow}, particularly for large graphs. In particular, the \emph{exhaustive} method is order factorial, and will take approximately forever for unlabeled graphs of size greater than about 7-9.} \seealso{ \code{\link{hdist}}, \code{\link{sdmat}} } \examples{ #Generate two random graphs g<-array(dim=c(3,5,5)) g[1,,]<-rgraph(5) g[2,,]<-rgraph(5) #Copy one of the graphs and permute it g[3,,]<-rmperm(g[2,,]) #What are the structural distances between the labeled graphs? structdist(g,exchange.list=1:5) #What are the structural distances between the underlying unlabeled #graphs? structdist(g,method="anneal", prob.init=0.9, prob.decay=0.85, freeze.time=50, full.neighborhood=TRUE) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/gcov.Rd0000644000176200001440000000604410501711235013032 0ustar liggesusers\name{gcov} \alias{gcov} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Covariance(s) Between Two or More Labeled Graphs} \description{ \code{gcov} finds the covariances between the adjacency matrices of graphs indicated by \code{g1} and \code{g2} in stack \code{dat} (or possibly \code{dat2}). Missing values are permitted. } \usage{ gcov(dat, dat2=NULL, g1=NULL, g2=NULL, diag=FALSE, mode="digraph") } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{dat2}{ optionally, a second graph stack. } \item{g1}{ the indices of \code{dat} reflecting the first set of graphs to be compared; by default, all members of \code{dat} are included. } \item{g2}{ the indices or \code{dat} (or \code{dat2}, if applicable) reflecting the second set of graphs to be compared; by default, all members of \code{dat} are included. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } } \details{ The graph covariance between two labeled graphs is defined as \deqn{cov(G,H) = \frac{1}{{|V| \choose 2}} \sum_{\{i,j\}} \left(A^G_{ij}-\mu_G\right)\left(A^H_{ij}-\mu_H\right)}{% cov(G,H) = sum( (A^G_ij-mu_G)(A^H_ij-mu_H), \{i,j\} )/Choose(|V|,2)} (with \eqn{A^G}{A^G} being the adjacency matrix of G). The graph correlation/covariance is at the center of a number of graph comparison methods, including network variants of regression analysis, PCA, CCA, and the like. Note that \code{gcov} computes only the covariance between \emph{uniquely labeled} graphs. For the more general case, \code{\link{gscov}} is recommended. } \value{ A graph covariance matrix } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The \code{gcov} routine is really just a front-end to the standard \code{\link{cov}} method; the primary value-added is the transparent vectorization of the input graphs (with intelligent handling of simple versus directed graphs, diagonals, etc.). Classical null hypothesis testing procedures are not recommended for use with graph covariance; for nonparametric null hypothesis testing regarding graph covariance, see \code{\link{cugtest}} and \code{\link{qaptest}}. } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{gscov}}, \code{\link{gcor}}, \code{\link{gscor}} } \examples{ #Generate two random graphs each of low, medium, and high density g<-rgraph(10,6,tprob=c(0.2,0.2,0.5,0.5,0.8,0.8)) #Examine the covariance matrix gcov(g) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ graphs } sna/man/add.isolates.Rd0000644000176200001440000000251311176465760014465 0ustar liggesusers\name{add.isolates} \alias{add.isolates} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Add Isolates to a Graph } \description{ Adds \code{n} isolates to the graph (or graphs) in \code{dat}. } \usage{ add.isolates(dat, n, return.as.edgelist = FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{n}{ the number of isolates to add. } \item{return.as.edgelist}{ logical; should the input graph be returned as an edgelist (rather than an adjacency matrix)?} } \details{ If \code{dat} contains more than one graph, the \code{n} isolates are added to each member of \code{dat}. } \value{ The updated graph(s). } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Inter-Structural Analysis.'' CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Isolate addition is particularly useful when computing structural distances between graphs of different orders; see the above reference for details. } \seealso{ \code{\link{isolates}} } \examples{ g<-rgraph(10,5) #Produce some random graphs dim(g) #Get the dimensions of g g<-add.isolates(g,2) #Add 2 isolates to each graph in g dim(g) #Now examine g g } \keyword{ manip } \keyword{ math } \keyword{ graphs } sna/man/print.netcancor.Rd0000644000176200001440000000133511176542152015212 0ustar liggesusers\name{print.netcancor} \alias{print.netcancor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for netcancor Objects } \description{ Prints a quick summary of objects produced by \code{\link{netcancor}}. } \usage{ \method{print}{netcancor}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{netcancor}} \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{netcancor}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/component.size.byvertex.Rd0000644000176200001440000000476013573635660016744 0ustar liggesusers\name{component.size.byvertex} \alias{component.size.byvertex} \alias{compsizes_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Get Component Sizes, by Vertex } \description{ This function computes the component structure of the input network, and returns a vector whose \eqn{i}th entry is the size of the component to which \eqn{i} belongs. This is useful e.g. for studies of diffusion or similar applications. } \usage{ component.size.byvertex(dat, connected = c("strong", "weak", "unilateral", "recursive")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs (for best performance, sna edgelists or network objects are suggested). } \item{connected}{ a string selecting the connectedness definition to use; by default, \code{"strong"} components are used. } } \details{ Component sizes are here computed using \code{\link{component.dist}}; see this function for additional information. In an undirected graph, the size of \eqn{v}'s component represents the maximum number of nodes that can be reached by a diffusion process along the edges of the graph originating with node \eqn{v}; the expectation of component sizes by vertex (rather than the mean component size) is thus one measure of the maximum average diffusion potential of a graph. Because this quantity is monotone with respect to edge addition, it can be bounded using Bernoulli graphs (see Butts (2011)). In the directed case, multiple types of components are possible; see \code{\link{component.dist}} for details. } \value{ A vector of length equal to the number of vertices in \code{dat}, whose \eqn{i}th element is the number of vertices in the component to which the \eqn{i}th vertex belongs. } \references{ West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall. Butts, C.T. (2011). \dQuote{Bernoulli Bounds for General Random Graphs.} \emph{Sociological Methodology}, 41, 299-345. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{component.dist}} } \examples{ #Generate a random undirected graph g<-rgraph(100,tprob=1.5/99,mode="graph",return.as.edgelist=TRUE) #Get the component sizes for each vertex cs<-component.size.byvertex(g) cs } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/sna-coercion.Rd0000644000176200001440000001520512743337257014475 0ustar liggesusers\name{sna-coercion} \alias{as.edgelist.sna} \alias{as.sociomatrix.sna} \alias{is.edgelist.sna} %- Also NEED an `\alias' for EACH other topic documented here. \title{ sna Coercion Functions } \description{ Functions to coerce network data into one form or another; these are generally internal, but may in some cases be helpful to the end user. } \usage{ as.sociomatrix.sna(x, attrname=NULL, simplify=TRUE, force.bipartite=FALSE) \method{as.edgelist}{sna}(x, attrname = NULL, as.digraph = TRUE, suppress.diag = FALSE, force.bipartite = FALSE, ...) is.edgelist.sna(x) } \arguments{ \item{x}{network data in any of several acceptable forms (see below).} \item{attrname}{if \code{x} is a \code{\link[network]{network}} object, the (optional) edge attribute to be used to obtain edge values.} \item{simplify}{logical; should output be simplified by collapsing adjacency matrices of identical dimension into adjacency arrays?} \item{force.bipartite}{logical; should the data be interpreted as bipartite (with rows and columns representing different data modes)?} \item{as.digraph}{logical; should \code{\link[network]{network}} objects be coded as digraphs, regardless of object properties? (Recommended)} \item{suppress.diag}{logical; should loops be suppressed?} \item{...}{ additional arguments to \code{sna.edgelist} (currently ignored). } } %- maybe also `usage' for other objects documented here. \details{ The \code{\link{sna}} coercion functions are normally called internally within user-level \code{\link{sna}} functions to convert network data from various supported forms into a format usable by the function in question. With few (if any) exceptions, formats acceptable by these functions should be usable with any user-level function in the \code{\link{sna}} library. \code{as.sociomatrix.sna} takes one or more input graphs, and returns them in adjacency matrix (and/or array) form. If \code{simplify==TRUE}, consolidation of matrices having the same dimensions into adjacency arrays is attempted; otherwise, elements are returned as lists of matrices/arrays. \code{as.edgelist.sna} takes one or more input graphs, and returns them in \code{sna} edgelist form -- i.e., a three-column matrix whose rows represent edges, and whose columns contain (respectively) the sender, receiver, and value of each edge. (Undirected graphs are generally assumed to be coded as fully mutual digraphs; edges may be listed in any order.) \code{sna} edgelists must also carry an attribute named \code{n} indicating the number of vertices in the graph, and may optionally contain the attributes \code{vnames} (carrying a vector of vertex names, in order) and/or \code{bipartite} (optionally, containing the number of row vertices in a two-mode network). If the bipartite attribute is present and non-false, vertices whose numbers are less than or equal to the attribute value are taken to belong to the first mode (i.e., row vertices), and those of value greater than the attribute are taken to belong to the second mode (i.e., column vertices). Note that the \code{bipartite} attribute is not strictly necessary to represent two-mode data, and may not be utilized by all \code{\link{sna}} functions. \code{is.edgelist.sna} returns \code{TRUE} if its argument is a \code{sna} edgelist, or \code{FALSE} otherwise; if called with a list, this check is performed (recursively) on the list elements. Data for \code{sna} coercion routines may currently consist of any combination of standard or sparse (via \code{SparseM}) adjacency matrices or arrays, \code{\link[network]{network}} objects, or \code{sna} edgelists. If multiple items are given, they must be contained within a \code{\link{list}}. Where adjacency arrays are specified, they must be in three-dimensional form, with dimensions given in graph/sender/receiver order. Matrices or arrays having different numbers of rows and columns are taken to be two-mode adjacency structures, and are treated accordingly; setting \code{force.bipartite} will cause square matrices to be treated in similar fashion. In the case of \code{\link[network]{network}} or \code{sna} edgelist matrices, bipartition information is normally read from the object's internal properties. } \value{ An adjacency or edgelist structure, or a list thereof. } %\references{ %} \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ For large, sparse graphs, edgelists can be dramatically more efficient than adjacency matrices. Where such savings can be realized, \code{\link{sna}} package functions usually employ \code{sna} edgelists as their \dQuote{native} format (coercing input data with \code{as.edgelist.sna} as needed). For this reason, users of large graphs can often obtain considerable savings by storing data in edgelist form, and passing edgelists (rather than adjacency matrices) to \code{\link{sna}} functions. The maximum size of adjacency matrices and edgelists depends upon \code{R}'s vector allocation limits. On a 64-bit platform, these limits are currently around 4.6e4 vertices (adjacency case) or 7.1e8 edges (edgelist case). The number of vertices in the edgelist case is effectively unlimited (and can technically be infinite), although not all functions will handle such objects gracefully. (Use of vertex names will limit the number of edgelist vertices to around 2e9.) } %Just FYI, precision problems for vertices don't arise until around 1e210 vertices, which is far larger than the estimated volume of the universe in cubic Planck lengths (about 1e186, according to Wikipedia). \seealso{ \code{\link{sna}}, \code{\link[network]{network}} } \examples{ #Produce some random data, and transform it g<-rgraph(5) g all(g==as.sociomatrix.sna(g)) #TRUE as.edgelist.sna(g) #View in edgelist form as.edgelist.sna(list(g,g)) #Double the fun g2<-as.sociomatrix.sna(list(g,g)) #Will simplify to an array dim(g2) g3<-as.sociomatrix.sna(list(g,g),simplify=FALSE) #Do not simplify g3 #Now a list #We can also build edgelists from scratch... n<-6 edges<-rbind( c(1,2,1), c(2,1,2), c(1,3,1), c(1,5,2), c(4,5,1), c(5,4,1) ) attr(edges,"n")<-n attr(edges,"vnames")<-letters[1:n] gplot(edges,displaylabels=TRUE) #Plot the graph as.sociomatrix.sna(edges) #Show in matrix form #Two-mode data works similarly n<-6 edges<-rbind( c(1,4,1), c(1,5,2), c(4,1,1), c(5,1,2), c(2,5,1), c(5,2,1), c(3,5,1), c(3,6,2), c(6,3,2) ) attr(edges,"n")<-n attr(edges,"vnames")<-c(letters[1:3],LETTERS[4:6]) attr(edges,"bipartite")<-3 edges gplot(edges,displaylabels=TRUE,gmode="twomode") #Plot as.sociomatrix.sna(edges) #Convert to matrix } \keyword{manip} \keyword{array} \keyword{math} \keyword{graphs} sna/man/pstar.Rd0000644000176200001440000001705114236140744013237 0ustar liggesusers\name{pstar} \alias{pstar} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Fit a p*/ERG Model Using a Logistic Approximation } \description{ Fits a p*/ERG model to the graph in \code{dat} containing the effects listed in \code{effects}. The result is returned as a \code{\link{glm}} object. } \usage{ pstar(dat, effects=c("choice", "mutuality", "density", "reciprocity", "stransitivity", "wtransitivity", "stranstri", "wtranstri", "outdegree", "indegree", "betweenness", "closeness", "degcentralization", "betcentralization", "clocentralization", "connectedness", "hierarchy", "lubness", "efficiency"), attr=NULL, memb=NULL, diag=FALSE, mode="digraph") } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a single graph } \item{effects}{ a vector of strings indicating which effects should be fit. } \item{attr}{ a matrix whose columns contain individual attributes (one row per vertex) whose differences should be used as supplemental predictors. } \item{memb}{ a matrix whose columns contain group memberships whose categorical similarities (same group/not same group) should be used as supplemental predictors.} \item{diag}{ a boolean indicating whether or not diagonal entries (loops) should be counted as meaningful data. } \item{mode}{ \code{"digraph"} if \code{dat} is directed, else \code{"graph"} } } \details{ The Exponential Family-Random Graph Model (ERGM) family, referred to as \dQuote{p*} in older literature, is an exponential family specification for network data. In this specification, it is assumed that \deqn{p(G=g) \propto \exp(\beta_0 \gamma_0(g) + \beta_1 \gamma_1(g) + \dots)}{% p(G=g) propto exp(beta_0 gamma_0(g) + beta_1 gamma_1(g) + \dots)} for all g, where the betas represent real coefficients and the gammas represent functions of g. Unfortunately, the unknown normalizing factor in the above expression makes evaluation difficult in the general case. One solution to this problem is to operate instead on the edgewise log odds; in this case, the ERGM/p* MLE can be approximated by a logistic regression of each edge on the \emph{differences} in the gamma scores induced by the presence and absence of said edge in the graph (conditional on all other edges). It is this approximation (known as autologistic regression, or maximum pseudo-likelihood estimation) that is employed here. Note that ERGM modeling is considerably more advanced than it was when this function was created, and estimation by MPLE is now used only in special cases. Guidelines for model specification and assessment have also evolved. The \code{ergm} package within the \code{statnet} library reflects the current state of the art, and use of the \code{ergm()} function in said library is highly recommended. This function is retained primarily as a legacy tool, for users who are nostalgic for 2000-vintage ERGM (\dQuote{p*}) modeling experience. Caveat emptor. Using the \code{effects} argument, a range of different potential parameters can be estimated. The network measure associated with each is, in turn, the edge-perturbed difference in: \enumerate{ \item \code{choice}: the number of edges in the graph (acts as a constant) \item \code{mutuality}: the number of reciprocated dyads in the graph \item \code{density}: the density of the graph \item \code{reciprocity}: the edgewise reciprocity of the graph \item \code{stransitivity}: the strong transitivity of the graph \item \code{wtransitivity}: the weak transitivity of the graph \item \code{stranstri}: the number of strongly transitive triads in the graph \item \code{wtranstri}: the number of weakly transitive triads in the graph \item \code{outdegree}: the outdegree of each actor (|V| parameters) \item \code{indegree}: the indegree of each actor (|V| parameters) \item \code{betweenness}: the betweenness of each actor (|V| parameters) \item \code{closeness}: the closeness of each actor (|V| parameters) \item \code{degcentralization}: the Freeman degree centralization of the graph \item \code{betcentralization}: the betweenness centralization of the graph \item \code{clocentralization}: the closeness centralization of the graph \item \code{connectedness}: the Krackhardt connectedness of the graph \item \code{hierarchy}: the Krackhardt hierarchy of the graph \item \code{efficiency}: the Krackhardt efficiency of the graph \item \code{lubness}: the Krackhardt LUBness of the graph } (Note that some of these do differ somewhat from the common specifications employed in the older p* literature, e.g. quantities such as density and reciprocity are computed as per the \code{\link{gden}} and \code{\link{grecip}} functions rather than via the unnormalized "choice" and "mutual" quantities that were generally used.) \emph{Please do not attempt to use all effects simultaneously!!!} In addition to the above, the user may specify a matrix of individual attributes whose absolute dyadic differences are to be used as predictors, as well as a matrix of individual memberships whose dyadic categorical similarities (same/different) are used in the same manner. Although the ERGM framework is quite versatile in its ability to accommodate a range of structural predictors, it should be noted that the \emph{substantial} collinearity of many of the terms provided here can lead to very unstable model fits. Measurement and specification errors compound this problem, as does the use of the MPLE; thus, it is somewhat risky to use \code{pstar} in an exploratory capacity (i.e., when there is little prior knowledge to constrain choice of parameters). While raw instability due to multicollinearity should decline with graph size, improper specification will still result in biased coefficient estimates so long as an omitted predictor correlates with an included predictor. Moreover, many models created using these effects are at risk of degeneracy, which is difficult to assess without simulation-based model assessment. Caution is advised - or, better, use of the \code{ergm} package. } \value{ A \code{\link{glm}} object } \references{ Anderson, C.; Wasserman, S.; and Crouch, B. (1999). ``A p* Primer: Logit Models for Social Networks. \emph{Social Networks,} 21,37-66. Holland, P.W., and Leinhardt, S. (1981). ``An Exponential Family of Probability Distributions for Directed Graphs.'' \emph{Journal of the American statistical Association}, 81, 51-67. Wasserman, S., and Pattison, P. (1996). ``Logit Models and Logistic Regressions for Social Networks: I. An introduction to Markov Graphs and p*.'' \emph{Psychometrika,} 60, 401-426. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ This is a legacy function - use of the \code{ergm} package is now strongly advised.} \section{WARNING }{Estimation of p* models by maximum pseudo-likelihood is now known to be a dangerous practice. Use at your own risk.} \seealso{ \code{\link{eval.edgeperturbation}} } \examples{ \dontrun{ #Create a graph with expansiveness and popularity effects in.str<-rnorm(20,0,3) out.str<-rnorm(20,0,3) tie.str<-outer(out.str,in.str,"+") tie.p<-apply(tie.str,c(1,2),function(a){1/(1+exp(-a))}) g<-rgraph(20,tprob=tie.p) #Fit a model with expansiveness only p1<-pstar(g,effects="outdegree") #Fit a model with expansiveness and popularity p2<-pstar(g,effects=c("outdegree","indegree")) #Fit a model with expansiveness, popularity, and mutuality p3<-pstar(g,effects=c("outdegree","indegree","mutuality")) #Compare the model AICs -- use ONLY as heuristics!!! extractAIC(p1) extractAIC(p2) extractAIC(p3) } } \keyword{ models } \keyword{ multivariate } \keyword{ regression }%-- one or more ... \keyword{ graphs } sna/man/gdist.plotstats.Rd0000644000176200001440000000744110501711235015244 0ustar liggesusers\name{gdist.plotstats} \alias{gdist.plotstats} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plot Various Graph Statistics Over a Network MDS } \description{ Plots a two-dimensional metric MDS of \code{d}, with the corresponding values of \code{meas} indicated at each point. Various options are available for controlling how \code{meas} is to be displayed. } \usage{ gdist.plotstats(d, meas, siz.lim=c(0, 0.15), rescale="quantile", display.scale="radius", display.type="circleray", cex=0.5, pch=1, labels=NULL, pos=1, labels.cex=1, legend=NULL, legend.xy=NULL, legend.cex=1, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{d}{ A matrix containing the inter-graph distances } \item{meas}{ An nxm matrix containing the graph-level measures; each row must correspond to a graph, and each column must correspond to an index } \item{siz.lim}{ The minimum and maximum sizes (respectively) of the plotted symbols, given as fractions of the total plotting range } \item{rescale}{ One of ``quantile'' for ordinal scaling, ``affine'' for max-min scaling, and ``normalize'' for rescaling by maximum value; these determine the scaling rule to be used in sizing the plotting symbols } \item{display.scale}{ One of ``area'' or ``radius''; this controls the attribute of the plotting symbol which is rescaled by the value of \code{meas}} \item{display.type}{ One of ``circle'', ``ray'', ``circleray'', ``poly'', or ``polyray''; this determines the type of plotting symbol used (circles, rays, polygons, or come combination of these) } \item{cex}{ Character expansion coefficient } \item{pch}{ Point types for the base plotting symbol (not the expanded symbols which are used to indicate \code{meas} values) } \item{labels}{ Point labels, if desired } \item{pos}{ Relative position of labels (see \code{\link{par}}) } \item{labels.cex}{ Character expansion factor for labels } \item{legend}{ Add a legend? } \item{legend.xy}{ x,y coordinates for legend } \item{legend.cex}{ Character expansion factor for legend } \item{\dots}{ Additional arguments to \code{\link{plot}} } } \details{ \code{gdist.plotstats} works by performing an MDS (using \code{\link{cmdscale}}) on \code{d}, and then using the values in \code{meas} to determine the shape of the points at each MDS coordinate. Typically, these shapes involve rays of varying color and length indicating \code{meas} magnitude, with circles and polygons of the appropriate radius and/or error being options as well. Various options are available (described above) to govern the details of the data display; some tinkering may be needed in order to produce an aesthetically pleasing visualization. The primary use of \code{gdist.plotstats} is to explore broad relationships between graph properties and inter-graph distances. This routine complements others in the \code{gdist} and \code{gclust} family of interstructural visualization tools. } \value{ None } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ This routine does not actually depend on the data's being graphic in origin, and can be used with any distance matrix/measure matrix combination. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\section{Requires}{\code{mva}} \seealso{ \code{\link{gdist.plotdiff}}, \code{\link{gclust.boxstats}}, \code{\link{gclust.centralgraph}} } \examples{ #Generate random graphs with varying density g<-rgraph(10,20,tprob=runif(20,0,1)) #Get Hamming distances between graphs g.h<-hdist(g) #Plot the association of distance, density, and reciprocity gdist.plotstats(g.h,cbind(gden(g),grecip(g))) } \keyword{ hplot }%-- one or more ... sna/man/gplot3d.Rd0000644000176200001440000001306611361535100013452 0ustar liggesusers\name{gplot3d} \alias{gplot3d} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Three-Dimensional Visualization of Graphs } \description{ \code{gplot3d} produces a three-dimensional plot of graph \code{g} in set \code{dat}. A variety of options are available to control vertex placement, display details, color, etc. } \usage{ gplot3d(dat, g = 1, gmode = "digraph", diag = FALSE, label = NULL, coord = NULL, jitter = TRUE, thresh = 0, mode = "fruchtermanreingold", displayisolates = TRUE, displaylabels = !missing(label), xlab = NULL, ylab = NULL, zlab = NULL, vertex.radius = NULL, absolute.radius = FALSE, label.col = "gray50", edge.col = "black", vertex.col = NULL, edge.alpha = 1, vertex.alpha = 1, edge.lwd = NULL, suppress.axes = TRUE, new = TRUE, bg.col = "white", layout.par = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ a graph or set thereof. This data may be valued. } \item{g}{ integer indicating the index of the graph (from \code{dat}) which is to be displayed. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected;\code{"twomode"} indicates that data should be interpreted as two-mode (i.e., rows and columns are distinct vertex sets). } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. } \item{label}{ a vector of vertex labels; setting this to a zero-length string (e.g., \code{""}) omits } \item{coord}{ user-specified vertex coordinates, in an \code{NCOL(dat)}x3 matrix. Where this is specified, it will override the \code{mode} setting. } \item{jitter}{ boolean; should vertex positions be jittered? } \item{thresh}{ real number indicating the lower threshold for tie values. Only ties of value >\code{thresh} are displayed. } \item{mode}{ the vertex placement algorithm; this must correspond to a \code{gplot3d.layout} function. } \item{displayisolates}{ boolean; should isolates be displayed? } \item{displaylabels}{ boolean; should vertex labels be displayed? } \item{xlab}{ X axis label. } \item{ylab}{ Y axis label. } \item{zlab}{ Z axis label. } \item{vertex.radius}{ vertex radius, relative to the baseline (which is set based on layout features); may be given as a vector, if radii vary across vertices. } \item{absolute.radius}{ vertex radius, specified in absolute terms; this may be given as a vector. } \item{label.col}{ color for vertex labels; may be given as a vector, if labels are to be of different colors. } \item{edge.col}{ color for edges; may be given as a vector or adjacency matrix, if edges are to be of different colors. } \item{vertex.col}{ color for vertices; may be given as a vector, if vertices are to be of different colors. By default, red is used (or red and blue, if \code{gmode=="twomode"}).} \item{edge.alpha}{ alpha (transparency) values for edges; may be given as a vector or adjacency matrix, if edge transparency is to vary. } \item{vertex.alpha}{ alpha (transparency) values for vertices; may be given as a vector, if vertex transparency is to vary. } \item{edge.lwd}{ line width scale for edges; if set greater than 0, edge widths are rescaled by \code{edge.lwd*dat}. May be given as a vector or adjacency matrix, if edges are to have different line widths. } \item{suppress.axes}{ boolean; suppress plotting of axes? } \item{new}{ boolean; create a new plot? If \code{new==FALSE}, the RGL device will not be cleared prior to adding vertices and edges. } \item{bg.col}{ background color for display. } \item{layout.par}{ list of parameters to the \code{\link{gplot.layout}} function specified in \code{mode}. } } \details{ \code{gplot3d} is the three-dimensional companion to \code{gplot}. As with the latter, clever manipulation of parameters can allow for a great deal of flexibility in the resulting display. (Displays produced by \code{gplot3d} are also interactive, to the extent supported by \code{\link[rgl:rgl-package]{rgl}}.) If vertex positions are not specified directly using \code{coord}, vertex layout is determined via one of the various available algorithms. These should be specified via the \code{mode} argument; see \code{\link{gplot3d.layout}} for a full list. User-supplied layout functions are also possible - see the aforementioned man page for details. Note that where \code{gmode=="twomode"}, the supplied two-mode graph is converted to bipartite form prior to computing coordinates (assuming it is not in this form already). It may be desirable to use parameters such as \code{vertex.col} to differentiate row and column vertices; by default, row vertices are colored red, and column vertices blue. } \value{ A three-column matrix containing vertex coordinates } \references{ Wasserman, S. and Faust, K. (1994) \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{Carter T. Butts \email{buttsc@uci.edu}} %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \section{Requires }{\code{\link[rgl:rgl-package]{rgl}}} \seealso{ \code{\link{gplot}}, \code{\link{gplot3d.layout}}, \code{\link[rgl:rgl-package]{rgl}} } \examples{ \dontrun{ #A three-dimensional grid... gplot3d(rgws(1,5,3,1,0)) #...rewired... gplot3d(rgws(1,5,3,1,0.05)) #...some more! gplot3d(rgws(1,5,3,1,0.2)) } } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/closeness.Rd0000644000176200001440000001265512743266623014117 0ustar liggesusers\name{closeness} \alias{closeness} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Closeness Centrality Scores of Network Positions } \description{ \code{closeness} takes one or more graphs (\code{dat}) and returns the closeness centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, closeness on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ closeness(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, cmode="directed", geodist.precomp=NULL, rescale=FALSE, ignore.eval=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ list indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{gmode} is set to "digraph" by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{cmode}{ string indicating the type of closeness centrality being computed (distances on directed or undirected pairs, or an alternate measure). } \item{geodist.precomp}{ a \code{\link{geodist}} object precomputed for the graph to be analyzed (optional) } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; should edge values be ignored when calculating geodesics?} } \details{ The closeness of a vertex v is defined as \deqn{C_C(v) = \frac{\left|V\left(G\right)\right|-1}{\sum_{i : i \neq v} d(v,i)}}{% C_C(v) = (|V(G)|-1)/sum( d(v,i), i in V(G), i!=v )} where \eqn{d(i,j)}{d(i,j)} is the geodesic distance between i and j (where defined). Closeness is ill-defined on disconnected graphs; in such cases, this routine substitutes \code{Inf}. It should be understood that this modification is not canonical (though it is common), but can be avoided by not attempting to measure closeness on disconnected graphs in the first place! Intuitively, closeness provides an index of the extent to which a given vertex has short paths to all other vertices in the graph; this is one reasonable measure of the extent to which a vertex is in the ``middle'' of a given structure. An alternate form of closeness (apparently due to Gil and Schmidt (1996)) is obtained by taking the sum of the inverse distances to each vertex, i.e. \deqn{C_C(v) = \frac{\sum_{i : i \neq v} \frac{1}{d(v,i)}}{\left|V\left(G\right)\right|-1}.}{% C_C(v) = sum( 1/d(v,i), i in V(G), i!=v )/(|V(G)|-1).} This measure correlates well with the standard form of closeness where both are well-defined, but lacks the latter's pathological behavior on disconnected graphs. Computation of alternate closeness may be performed via the argument \code{cmode="suminvdir"} (directed case) and \code{cmode="suminvundir"} (undirected case). The corresponding arguments \code{cmode="directed"} and \code{cmode="undirected"} return the standard closeness scores in the directed or undirected cases (respectively). Although treated here as a measure of closeness, this index was originally intended to capture power or efficacy; in its original form, the Gil-Schmidt power index is a renormalized version of the above. Specifically, let \eqn{R(v,G)} be the set of vertices reachable by \eqn{v} in \eqn{V\setminus v}{V \ v}. Then the Gil-Schmidt power index is defined as \deqn{C_{GS}(v) = \frac{\sum_{i \in R(v,G)} \frac{1}{d(v,i)}}{|R(v,G)|}.}{% C_GS(v) = sum( 1/d(v,i), i in R(v,G) )/|R(v,G)|,} with \eqn{C_{GS}}{C_GS} defined to be 0 for vertices with no outneighbors. This may be obtained via the argument \code{cmode="gil-schmidt"}. } \value{ A vector, matrix, or list containing the closeness scores (depending on the number and size of the input graphs). } \references{Freeman, L.C. (1979). \dQuote{Centrality in Social Networks I: Conceptual Clarification.} \emph{Social Networks}, 1, 215-239. Gil, J. and Schmidt, S. (1996). \dQuote{The Origin of the Mexican Network of Power}. Proceedings of the International Social Network Conference, Charleston, SC, 22-25. Sinclair, P.A. (2009). \dQuote{Network Centralization with the Gil Schmidt Power Centrality Index} \emph{Social Networks}, 29, 81-92. } \author{ Carter T. Butts, \email{buttsc@uci.edu} } \note{ Judicious use of \code{geodist.precomp} can save a great deal of time when computing multiple path-based indices on the same network. } \seealso{ \code{\link{centralization}} } \examples{ g<-rgraph(10) #Draw a random graph with 10 members closeness(g) #Compute closeness scores } \keyword{univar }%-- one or more ... \keyword{ math } \keyword{graphs} sna/man/gscor.Rd0000644000176200001440000001605710501711235013216 0ustar liggesusers\name{gscor} \alias{gscor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Structural Correlations Between Two or More Graphs } \description{ \code{gscor} finds the product-moment structural correlation between the adjacency matrices of graphs indicated by \code{g1} and \code{g2} in stack \code{dat} (or possibly \code{dat2}) given exchangeability list \code{exchange.list}. Missing values are permitted. } \usage{ gscor(dat, dat2=NULL, g1=NULL, g2=NULL, diag=FALSE, mode="digraph", method="anneal", reps=1000, prob.init=0.9, prob.decay=0.85, freeze.time=25, full.neighborhood=TRUE, exchange.list=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a stack of input graphs. } \item{dat2}{ optionally, a second graph stack. } \item{g1}{ the indices of \code{dat} reflecting the first set of graphs to be compared; by default, all members of \code{dat} are included. } \item{g2}{ the indices or \code{dat} (or \code{dat2}, if applicable) reflecting the second set of graphs to be compared; by default, all members of \code{dat} are included. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default. } \item{method}{ method to be used to search the space of accessible permutations; must be one of \code{"none"}, \code{"exhaustive"}, \code{"anneal"}, \code{"hillclimb"}, or \code{"mc"}. } \item{reps}{ number of iterations for Monte Carlo method. } \item{prob.init}{ initial acceptance probability for the annealing routine. } \item{prob.decay}{ cooling multiplier for the annealing routine. } \item{freeze.time}{ freeze time for the annealing routine. } \item{full.neighborhood}{ should the annealer evaluate the full neighborhood of pair exchanges at each iteration? } \item{exchange.list}{ information on which vertices are exchangeable (see below); this must be a single number, a vector of length n, or a nx2 matrix. } } \details{ The structural correlation coefficient between two graphs G and H is defined as \deqn{scor\left(G,H \left| L_G,L_H\right.\right) = \max_{L_G,L_H} cor(\ell(G),\ell(H))}{% scor(G,H | L_G,L_H) = max_[L_G,L_H] cor(l(G),l(H))} where \eqn{L_G} is the set of accessible permutations/labelings of G, \eqn{\ell(G)}{l(G)} is a permutation/relabeling of G, and \eqn{\ell(G) \in L_G}{l(G) in L_G}. The set of accessible permutations on a given graph is determined by the \emph{theoretical exchangeability} of its vertices; in a nutshell, two vertices are considered to be theoretically exchangeable for a given problem if all predictions under the conditioning theory are invariant to a relabeling of the vertices in question (see Butts and Carley (2001) for a more formal exposition). Where no vertices are exchangeable, the structural correlation becomes the simple graph correlation. Where \emph{all} vertices are exchangeable, the structural correlation reflects the correlation between unlabeled graphs; other cases correspond to correlation under partial labeling. The accessible permutation set is determined by the \code{exchange.list} argument, which is dealt with in the following manner. First, \code{exchange.list} is expanded to fill an nx2 matrix. If \code{exchange.list} is a single number, this is trivially accomplished by replication; if \code{exchange.list} is a vector of length n, the matrix is formed by cbinding two copies together. If \code{exchange.list} is already an nx2 matrix, it is left as-is. Once the nx2 exchangeability matrix has been formed, it is interpreted as follows: columns refer to graphs 1 and 2, respectively; rows refer to their corresponding vertices in the original adjacency matrices; and vertices are taken to be theoretically exchangeable iff their corresponding exchangeability matrix values are identical. To obtain an unlabeled graph correlation (the default), then, one could simply let \code{exchange.list} equal any single number. To obtain the standard graph correlation, one would use the vector \code{1:n}. Because the set of accessible permutations is, in general, very large (\eqn{o(n!)}), searching the set for the maximum correlation is a non-trivial affair. Currently supported methods for estimating the structural correlation are hill climbing, simulated annealing, blind monte carlo search, or exhaustive search (it is also possible to turn off searching entirely). Exhaustive search is not recommended for graphs larger than size 8 or so, and even this may take days; still, this is a valid alternative for small graphs. Blind monte carlo search and hill climbing tend to be suboptimal for this problem and are not, in general recommended, but they are available if desired. The preferred (and default) option for permutation search is simulated annealing, which seems to work well on this problem (though some tinkering with the annealing parameters may be needed in order to get optimal performance). See the help for \code{\link{lab.optimize}} for more information regarding these options. Structural correlation matrices are p.s.d., and are p.d. so long as no graph within the set is a linear combination of any other under any accessible permutation. Their eigendecompositions are meaningful and they may be used in linear subspace analyses, so long as the researcher is careful to interpret the results in terms of the appropriate set of accessible labelings. Classical null hypothesis tests should not be employed with structural correlations, and QAP tests are almost never appropriate (save in the uniquely labeled case). See \code{\link{cugtest}} for a more reasonable alternative. } \value{ An estimate of the structural correlation matrix } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS Working Paper, Carnegie Mellon University.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Consult Butts and Carley (2001) for advice and examples on theoretical exchangeability. } \section{Warning }{The search process can be \emph{very slow}, particularly for large graphs. In particular, the \emph{exhaustive} method is order factorial, and will take approximately forever for unlabeled graphs of size greater than about 7-9.} \seealso{ \code{\link{gscov}}, \code{\link{gcor}}, \code{\link{gcov}} } \examples{ #Generate two random graphs g.1<-rgraph(5) g.2<-rgraph(5) #Copy one of the graphs and permute it perm<-sample(1:5) g.3<-g.2[perm,perm] #What are the structural correlations between the labeled graphs? gscor(g.1,g.2,exchange.list=1:5) gscor(g.1,g.3,exchange.list=1:5) gscor(g.2,g.3,exchange.list=1:5) #What are the structural correlations between the underlying #unlabeled graphs? gscor(g.1,g.2) gscor(g.1,g.3) gscor(g.2,g.3) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ graphs } sna/man/print.summary.lnam.Rd0000644000176200001440000000213411176527555015671 0ustar liggesusers\name{print.summary.lnam} \alias{print.summary.lnam} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Printing for summary.lnam Objects } \description{ Prints an object of class \code{summary.lnam}. } \usage{ \method{print}{summary.lnam}(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{summary.lnam}. } \item{digits}{ number of digits to display. } \item{signif.stars}{ show significance stars? } \item{\dots}{ additional arguments. } } %\details{ % ~~ If necessary, more details than the __description__ above ~~ %} \value{ None } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{summary.lnam}}, \code{\link{lnam}} } %\examples{ %} \keyword{ print }% at least one, from doc/KEYWORDS %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line sna/man/sr2css.Rd0000644000176200001440000000301210501711234013302 0ustar liggesusers\name{sr2css} \alias{sr2css} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Convert a Row-wise Self-Report Matrix to a CSS Matrix with Missing Observations } \description{ Given a matrix in which the ith row corresponds to i's reported relations, \code{sr2css} creates a graph stack in which each element represents a CSS slice with missing observations. } \usage{ sr2css(net) } %- maybe also `usage' for other objects documented here. \arguments{ \item{net}{ an adjacency matrix. } } \details{ A cognitive social structure (CSS) is an nxnxn array in which the ith matrix corresponds to the ith actor's perception of the entire network. Here, we take a conventional self-report data structure and put it in CSS format for routines (such as \code{\link{bbnam}}) which require this. } \value{ An array (graph stack) containing the CSS } \references{ Krackhardt, D. (1987). \emph{Cognitive Social Structures}, 9, 109-134. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ A row-wise self-report matrix doesn't contain a great deal of data, and the data in question is certainly not an ignorable sample of the individual's CSS for most purposes. The provision of this routine should not be perceived as license to substitute SR for CSS data at will. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #Start with some random reports g<-rgraph(10) #Transform to CSS format c<-sr2css(g) } \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/print.summary.qaptest.Rd0000644000176200001440000000136211176541654016421 0ustar liggesusers\name{print.summary.qaptest} \alias{print.summary.qaptest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.qaptest Objects } \description{ Prints an object of class \code{summary.qaptest}. } \usage{ \method{print}{summary.qaptest}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.qaptest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.qaptest}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/rmperm.Rd0000644000176200001440000000173610501711234013400 0ustar liggesusers\name{rmperm} \alias{rmperm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Randomly Permute the Rows and Columns of an Input Matrix } \description{ Given an input matrix (or stack thereof), \code{rmperm} performs a (random) simultaneous row/column permutation of the input data. } \usage{ rmperm(m) } %- maybe also `usage' for other objects documented here. \arguments{ \item{m}{ a matrix, or stack thereof (or a graph set, for that matter). } } \details{ Random matrix permutations are the essence of the QAP test; see \code{\link{qaptest}} for details. } \value{ The permuted matrix (or matrices) } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{rperm}} } \examples{ #Generate an input matrix g<-rgraph(5) g #Examine it #Examine a random permutation rmperm(g) } \keyword{ array } \keyword{ distribution }%-- one or more ... sna/man/rgraph.Rd0000644000176200001440000000711213573636716013402 0ustar liggesusers\name{rgraph} \alias{rgraph} \alias{rgbern_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generate Bernoulli Random Graphs } \description{ \code{rgraph} generates random draws from a Bernoulli graph distribution, with various parameters for controlling the nature of the data so generated. } \usage{ rgraph(n, m=1, tprob=0.5, mode="digraph", diag=FALSE, replace=FALSE, tielist=NULL, return.as.edgelist=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{n}{ The size of the vertex set (|V(G)|) for the random graphs } \item{m}{ The number of graphs to generate } \item{tprob}{ Information regarding tie (edge) probabilities; see below } \item{mode}{ ``digraph'' for directed data, ``graph'' for undirected data } \item{diag}{ Should the diagonal entries (loops) be set to zero? } \item{replace}{ Sample with or without replacement from a tie list (ignored if \code{tielist==NULL} } \item{tielist}{ A vector of edge values, from which the new graphs should be bootstrapped } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in edgelist form?} } \details{ \code{rgraph} is a reasonably versatile routine for generating random network data. The graphs so generated are either Bernoulli graphs (graphs in which each edge is a Bernoulli trial, independent conditional on the Bernoulli parameters), or are bootstrapped from a user-provided edge distribution (very handy for CUG tests). In the latter case, edge data should be provided using the \code{tielist} argument; the exact form taken by the data is irrelevant, so long as it can be coerced to a vector. In the former case, Bernoulli graph probabilities are set by the \code{tprob} argument as follows: \enumerate{ \item If \code{tprob} contains a single number, this number is used as the probability of all edges. \item If \code{tprob} contains a vector, each entry is assumed to correspond to a separate graph (in order). Thus, each entry is used as the probability of all edges within its corresponding graph. \item If \code{tprob} contains a matrix, then each entry is assumed to correspond to a separate edge. Thus, each entry is used as the probability of its associated edge in each graph which is generated. \item Finally, if \code{tprob} contains a three-dimensional array, then each entry is assumed to correspond to a particular edge in a particular graph, and is used as the associated probability parameter. } Finally, note that \code{rgraph} will symmetrize all generated networks if \code{mode} is set to ``graph'' by copying down the upper triangle. The lower half of \code{tprob}, where applicable, must still be specified, however. } \value{ A graph stack } \references{ Erdos, P. and Renyi, A. (1960). \dQuote{On the Evolution of Random Graphs.} \emph{Public Mathematical Institute of Hungary Academy of Sciences,} 5:17-61. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The famous mathematicians referenced in this man page now have misspelled names, due to R's difficulty with accent marks. } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{rmperm}}, \code{\link{rgnm}}, \code{\link{rguman}} } \examples{ #Generate three graphs with different densities g<-rgraph(10,3,tprob=c(0.1,0.9,0.5)) #Generate from a matrix of Bernoulli parameters g.p<-matrix(runif(25,0,1),nrow=5) g<-rgraph(5,2,tprob=g.p) } \keyword{ distribution }%-- one or more ... \keyword{ math } sna/man/summary.bbnam.Rd0000644000176200001440000000147311176706372014667 0ustar liggesusers\name{summary.bbnam} \alias{summary.bbnam} \alias{summary.bbnam.fixed} \alias{summary.bbnam.pooled} \alias{summary.bbnam.actor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of bbnam Objects } \description{ Returns a \code{bbnam} summary object } \usage{ \method{summary}{bbnam}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{bbnam} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ An object of class \code{summary.bbnam} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/plot.cugtest.Rd0000644000176200001440000000264311176527367014554 0ustar liggesusers\name{plot.cugtest} \alias{plot.cugtest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plotting for cugtest Objects } \description{ Plots the distribution of a CUG test statistic. } \usage{ \method{plot}{cugtest}(x, mode="density", ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ A \code{\link{cugtest}} object } \item{mode}{ ``density'' for kernel density estimation, ``hist'' for histogram } \item{\dots}{ Additional arguments to \code{\link{plot}} } } \details{ In addition to the quantiles associated with a CUG test, it is often useful to examine the form of the distribution of the test statistic. \code{plot.cugtest} facilitates this. } \value{ None } \references{ Anderson, B.S.; Butts, C.T.; and Carley, K.M. (1999). ``The Interaction of Size and Density with Graph-Level Indices.'' \emph{Social Networks}, 21(3), 239-267. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{cugtest}} } \examples{ #Draw two random graphs, with different tie probabilities dat<-rgraph(20,2,tprob=c(0.2,0.8)) #Is their correlation higher than would be expected, conditioning #only on size? cug<-cugtest(dat,gcor,cmode="order") summary(cug) plot(cug) #Now, let's try conditioning on density as well. cug<-cugtest(dat,gcor) plot(cug) } \keyword{ hplot }%-- one or more ... sna/man/print.netlm.Rd0000644000176200001440000000130211176542131014344 0ustar liggesusers\name{print.netlm} \alias{print.netlm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for netlm Objects } \description{ Prints a quick summary of objects produced by \code{\link{netlm}}. } \usage{ \method{print}{netlm}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{netlm}} \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{netlm}}} %\examples{ %} \keyword{ print }%-- one or more ... sna/man/symmetrize.Rd0000644000176200001440000000264011176526542014320 0ustar liggesusers\name{symmetrize} \alias{symmetrize} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Symmetrize an Adjacency Matrix } \description{ Symmetrizes the elements of \code{mats} according to the rule in \code{rule}. } \usage{ symmetrize(mats, rule="weak", return.as.edgelist=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{mats}{ a graph or graph stack.} \item{rule}{ one of ``upper'', ``lower'', ``strong'' or ``weak''. } \item{return.as.edgelist}{ logical; should the symmetrized graphs be returned in edgelist form?} } \details{ The rules used by \code{symmetrize} are as follows: \enumerate{ \item upper: Copy the upper triangle over the lower triangle \item lower: Copy the lower triangle over the upper triangle \item strong: i<->j iff i->j and i<-j (AND rule) \item weak: i<->j iff i->j or i<-j (OR rule) } } \value{ The symmetrized graph stack } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #Generate a graph g<-rgraph(5) #Weak symmetrization symmetrize(g) #Strong symmetrization symmetrize(g,rule="strong") } \keyword{ manip } \keyword{ array }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/write.nos.Rd0000644000176200001440000000474610501711234014032 0ustar liggesusers\name{write.nos} \alias{write.nos} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Write Output Graphs in (N)eo-(O)rg(S)tat Format } \description{ Writes a graph stack to an output file in NOS format. } \usage{ write.nos(x, file, row.col = NULL, col.col = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a graph or graph stack (all graphs must be of common order). } \item{file}{ string containing the output file name. } \item{row.col}{ vector of row labels (or "row colors"). } \item{col.col}{ vector of column labels ("column colors"). } } \details{ NOS format consists of three header lines, followed by a whitespace delimited stack of raw adjacency matrices; the format is not particularly elegant, but turns up in certain legacy applications (mostly at CMU). \code{write.nos} provides a quick and dirty way of writing files NOS, which can later be retrieved using \code{\link{read.nos}}. The content of the NOS format is as follows: ... ... ... ... ... ... ... ... ... ... ... where is understood to be the value of the c->d edge in the bth graph of the file. (As one might expect, m, n, and o are the numbers of graphs (matrices), rows, and columns for the data, respectively.) The "k" line contains a list of row and column "colors", categorical variables associated with each row and column, respectively. Although originally intended to communicate exchangability information, these can be used for other purposes (though there are easier ways to deal with attribute data these days). Note that NOS format only supports graph stacks of common order; graphs of different sizes cannot be stored within the same file. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{read.nos}}, \code{\link{write.dl}}, \code{\link{write.table}} } \examples{ \dontrun{ #Generate a random graph stack g<-rgraph(5,10) #This would save the graphs in NOS format write.nos(g,file="testfile.nos") #We can also read them back, like so: g2<-read.nos("testfile.nos") } } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ file }% __ONLY ONE__ keyword per line sna/man/read.dot.Rd0000644000176200001440000000216410501711234013572 0ustar liggesusers\name{read.dot} \alias{read.dot} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Read Graphviz DOT Files } \description{ Reads network information in Graphviz's DOT format, returning an adjacency matrix. } \usage{ read.dot(...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{\dots}{ The name of the file whence to import the data, or else a connection object (suitable for processing by \code{\link{readLines}}. } } \details{ The Graphviz project's DOT language is a simple but flexible tool for describing graphs. See the included reference for details. } \value{ The imported graph, in adjacency matrix form. } \references{ Graphviz Project. "The DOT Language." http://www.graphviz.org/doc/info/lang.html } \author{ Matthijs den Besten \email{matthijs.denbesten@gmail.com} } %\note{ ~~further notes~~ % % ~Make other sections like Warning with \section{Warning }{....} ~ %} \seealso{ \code{\link{read.nos}}, \code{\link{write.nos}}, \code{\link{write.dl}} } %\examples{ %} \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ file }% __ONLY ONE__ keyword per line sna/man/read.nos.Rd0000644000176200001440000000407111177141606013614 0ustar liggesusers\name{read.nos} \alias{read.nos} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Read (N)eo-(O)rg(S)tat Input Files} \description{ Reads an input file in NOS format, returning the result as a graph set. } \usage{ read.nos(file, return.as.edgelist = FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{file}{ the file to be imported } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in sna edgelist format?} } \details{ NOS format consists of three header lines, followed by a whitespace delimited stack of raw adjacency matrices; the format is not particularly elegant, but turns up in certain legacy applications (mostly at CMU). \code{read.nos} provides a quick and dirty way of reading in these files, without the headache of messing with \code{\link{read.table}} settings. The content of the NOS format is as follows: ... ... ... ... ... ... ... ... ... ... ... where is understood to be the value of the c->d edge in the bth graph of the file. (As one might expect, m, n, and o are the numbers of graphs (matrices), rows, and columns for the data, respectively.) The "k" line contains a list of row and column "colors", categorical variables associated with each row and column, respectively. Although originally intended to communicate exchangability information, these can be used for other purposes (though there are easier ways to deal with attribute data these days). } \value{ The imported graph set (in adjacency array or edgelist form). } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ \code{read.nos} currently ignores the coloring information. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{write.nos}}, \code{\link{scan}}, \code{\link{read.table}} } %\examples{ % %} \keyword{ file }%-- one or more ... \keyword{graphs} sna/man/gilschmidt.Rd0000644000176200001440000000674113573636220014243 0ustar liggesusers\name{gilschmidt} \alias{gilschmidt} \alias{gilschmidt_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute the Gil-Schmidt Power Index } \description{ \code{gilschmidt} computes the Gil-Schmidt Power Index for all nodes in \code{dat}, with or without normalization. } \usage{ gilschmidt(dat, g = 1, nodes = NULL, gmode = "digraph", diag = FALSE, tmaxdev = FALSE, normalize = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs (for best performance, sna edgelists or network objects are suggested). } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ list indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{gmode} is set to \code{"digraph"} by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. (This has no effect on this index, but is included for compatibility with \code{\link{centralization}}. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{normalize}{ logical; should the index scores be normalized? } } \details{ For graph \eqn{G=(V,E)}, let \eqn{R(v,G)} be the set of vertices reachable by \eqn{v} in \eqn{V\setminus v}{V \ v}. Then the Gil-Schmidt power index is defined as \deqn{C_{GS}(v) = \frac{\sum_{i \in R(v,G)} \frac{1}{d(v,i)}}{|R(v,G)|}.}{% C_GS(v) = sum( 1/d(v,i), i in R(v,G) )/|R(v,G)|,} where \eqn{d(v,i)} is the geodesic distance from \eqn{v} to \eqn{i} in \eqn{G}; the index is taken to be 0 for isolates. The measure takes a value of 1 when \eqn{v} is adjacent to all reachable vertices, and approaches 0 as the distance from \eqn{v} to each vertex approaches infinity. (For finite \eqn{N=|V|}, the minimum value is 0 if \eqn{v} is an isolate, and otherwise \eqn{1/(N-1)}.) If \code{normalize=FALSE} is selected, then normalization by \eqn{|R(v,G)|} is not performed. This measure has been proposed as a better-behaved alternative to closeness (to which it is closely related). The \code{\link{closeness}} function in the sna library can also be used to compute this index. } \value{ A vector of centrality scores. } \references{ Gil, J. and Schmidt, S. (1996). \dQuote{The Origin of the Mexican Network of Power}. Proceedings of the International Social Network Conference, Charleston, SC, 22-25. Sinclair, P.A. (2009). \dQuote{Network Centralization with the Gil Schmidt Power Centrality Index} \emph{Social Networks}, 29, 81-92. } \author{ Carter T. Butts, \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{closeness}, \link{centralization}} } \examples{ data(coleman) #Load Coleman friendship network gs<-gilschmidt(coleman,g=1:2) #Compute the Gil-Schmidt index #Plot G-S values in the fall, versus spring plot(gs,xlab="Fall",ylab="Spring",main="G-S Index") abline(0,1) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/gcor.Rd0000644000176200001440000000710310501711235013023 0ustar liggesusers\name{gcor} \alias{gcor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the (Product-Moment) Correlation Between Two or More Labeled Graphs } \description{ \code{gcor} finds the product-moment correlation between the adjacency matrices of graphs indicated by \code{g1} and \code{g2} in stack \code{dat} (or possibly \code{dat2}). Missing values are permitted. } \usage{ gcor(dat, dat2=NULL, g1=NULL, g2=NULL, diag=FALSE, mode="digraph") } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{dat2}{ optionally, a second stack of graphs. } \item{g1}{ the indices of \code{dat} reflecting the first set of graphs to be compared; by default, all members of \code{dat} are included. } \item{g2}{ the indices or \code{dat} (or \code{dat2}, if applicable) reflecting the second set of graphs to be compared; by default, all members of \code{dat} are included. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. "Digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } } \details{ The (product moment) graph correlation between labeled graphs G and H is given by \deqn{cor(G,H) = \frac{cov(G,H)}{\sqrt{cov(G,G) cov(H,H)}} }{% cor(G,H) = cov(G,V)/sqrt(cov(G,G)cov(H,H))} where the graph covariance is defined as \deqn{cov(G,H) = \frac{1}{{|V| \choose 2}} \sum_{\{i,j\}} \left(A^G_{ij}-\mu_G\right)\left(A^H_{ij}-\mu_H\right)}{% cov(G,H) = sum( (A^G_ij-mu_G)(A^H_ij-mu_H), \{i,j\} )/Choose(|V|,2)} (with \eqn{A^G}{A^G} being the adjacency matrix of G). The graph correlation/covariance is at the center of a number of graph comparison methods, including network variants of regression analysis, PCA, CCA, and the like. Note that \code{gcor} computes only the correlation between \emph{uniquely labeled} graphs. For the more general case, \code{\link{gscor}} is recommended. } \value{ A graph correlation matrix } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS Working Paper, Carnegie Mellon University. Krackhardt, D. (1987). ``QAP Partialling as a Test of Spuriousness.'' \emph{Social Networks}, 9, 171-86 } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The \code{gcor} routine is really just a front-end to the standard \code{\link{cor}} method; the primary value-added is the transparent vectorization of the input graphs (with intelligent handling of simple versus directed graphs, diagonals, etc.). As noted, the correlation coefficient returned is a standard Pearson's product-moment coefficient, and output should be interpreted accordingly. Classical null hypothesis testing procedures are not recommended for use with graph correlations; for nonparametric null hypothesis testing regarding graph correlations, see \code{\link{cugtest}} and \code{\link{qaptest}}. For multivariate correlations among graph sets, try \code{\link{netcancor}}. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{gscor}}, \code{\link{gcov}}, \code{\link{gscov}} } \examples{ #Generate two random graphs each of low, medium, and high density g<-rgraph(10,6,tprob=c(0.2,0.2,0.5,0.5,0.8,0.8)) #Examine the correlation matrix gcor(g) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ graphs } sna/man/lnam.Rd0000644000176200001440000001504610645450075013040 0ustar liggesusers\name{lnam} \alias{lnam} \alias{coef.lnam} \alias{se.lnam} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Fit a Linear Network Autocorrelation Model } \description{ \code{lnam} is used to fit linear network autocorrelation models. These include standard OLS as a special case, although \code{\link{lm}} is to be preferred for such analyses. } \usage{ lnam(y, x = NULL, W1 = NULL, W2 = NULL, theta.seed = NULL, null.model = c("meanstd", "mean", "std", "none"), method = "BFGS", control = list(), tol=1e-10) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{y}{ a vector of responses. } \item{x}{ a vector or matrix of covariates; if the latter, each column should contain a single covariate. } \item{W1}{ one or more (possibly valued) graphs on the elements of \code{y}. } \item{W2}{ one or more (possibly valued) graphs on the elements of \code{y}. } \item{theta.seed}{ an optional seed value for the parameter vector estimation process. } \item{null.model}{ the null model to be fit; must be one of \code{"meanstd"}, \code{"mean"}, \code{"std"}, or \code{"none"}. } \item{method}{ method to be used with \code{\link{optim}}. } \item{control}{ optional control parameters for \code{\link{optim}}. } \item{tol}{ convergence tolerance for the MLE (expressed as change in deviance).} } \details{ \code{lnam} fits the linear network autocorrelation model given by \deqn{y = W_1 y + X \beta + e, \quad e = W_2 e + \nu}{% y = W1 \%*\% y + X \%*\% beta + e, e = W2 \%*\% e + nu} where \eqn{y} is a vector of responses, \eqn{X} is a covariate matrix, \eqn{\nu \sim N(0,\sigma^2)}{nu ~ Norm(0,sigma^2)}, \deqn{W_1 = \sum_{i=1}^p \rho_{1i} W_{1i}, \quad W_2 = \sum_{i=1}^q \rho_{2i} W_{2i},}{% W1 = sum( rho1_i W1_i, i=1..p), W2 = sum( rho2_i W2_i, i=1..q),} and \eqn{W_{1i}}{W1_i}, \eqn{W_{2i}}{W2_i} are (possibly valued) adjacency matrices. Intuitively, \eqn{\rho_1}{rho1} is a vector of ``AR''-like parameters (parameterizing the autoregression of each \eqn{y} value on its neighbors in the graphs of \eqn{W_1}{W1}) while \eqn{\rho_2}{rho2} is a vector of ``MA''-like parameters (parameterizing the autocorrelation of each \emph{disturbance} in \eqn{y} on its neighbors in the graphs of \eqn{W_2}{W2}). In general, the two models are distinct, and either or both effects may be selected by including the appropriate matrix arguments. Model parameters are estimated by maximum likelihood, and asymptotic standard errors are provided as well; all of the above (and more) can be obtained by means of the appropriate \code{print} and \code{summary} methods. A plotting method is also provided, which supplies fit basic diagnostics for the estimated model. For purposes of comparison, fits may be evaluated against one of four null models: \enumerate{ \item \code{meanstd}: mean and standard deviation estimated (default). \item \code{mean}: mean estimated; standard deviation assumed equal to 1. \item \code{std}: standard deviation estimated; mean assumed equal to 0. \item \code{none}: no parameters estimated; data assumed to be drawn from a standard normal density. } The default setting should be appropriate for the vast majority of cases, although the others may have use when fitting ``pure'' autoregressive models (e.g., without covariates). Although a major use of the \code{lnam} is in controlling for network autocorrelation within a regression context, the model is subtle and has a variety of uses. (See the references below for suggestions.) } \value{ An object of class \code{"lnam"} containing the following elements: \item{y}{the response vector used.} \item{x}{if supplied, the coefficient matrix.} \item{W1}{if supplied, the W1 array.} \item{W2}{if supplied, the W2 array.} \item{model}{a code indicating the model terms fit.} \item{infomat}{the estimated Fisher information matrix for the fitted model.} \item{acvm}{the estimated asymptotic covariance matrix for the model parameters.} \item{null.model}{a string indicating the null model fit.} \item{lnlik.null}{the log-likelihood of y under the null model.} \item{df.null.resid}{the residual degrees of freedom under the null model.} \item{df.null}{the model degrees of freedom under the null model.} \item{null.param}{parameter estimates for the null model.} \item{lnlik.model}{the log-likelihood of y under the fitted model.} \item{df.model}{the model degrees of freedom.} \item{df.residual}{the residual degrees of freedom.} \item{df.total}{the total degrees of freedom.} \item{rho1}{if applicable, the MLE for rho1.} \item{rho1.se}{if applicable, the asymptotic standard error for rho1.} \item{rho2}{if applicable, the MLE for rho2.} \item{rho2.se}{if applicable, the asymptotic standard error for rho2.} \item{sigma}{the MLE for sigma.} \item{sigma.se}{the standard error for sigma} \item{beta}{if applicable, the MLE for beta.} \item{beta.se}{if applicable, the asymptotic standard errors for beta.} \item{fitted.values}{the fitted mean values.} \item{residuals}{the residuals (response minus fitted); note that these correspond to \eqn{\hat{e}}{e-hat} in the model equation, not \eqn{\hat{\nu}}{nu-hat}.} \item{disturbances}{the estimated disturbances, i.e., \eqn{\hat{\nu}}{nu-hat}.} \item{call}{the matched call.} } \references{ Leenders, T.Th.A.J. (2002) ``Modeling Social Influence Through Network Autocorrelation: Constructing the Weight Matrix'' \emph{Social Networks}, 24(1), 21-47. Anselin, L. (1988) \emph{Spatial Econometrics: Methods and Models.} Norwell, MA: Kluwer. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Actual optimization is performed by calls to \code{\link{optim}}. Information on algorithms and control parameters can be found via the appropriate man pages. } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{lm}}, \code{\link{optim}} } \examples{ \dontrun{ #Construct a simple, random example: w1<-rgraph(100) #Draw the AR matrix w2<-rgraph(100) #Draw the MA matrix x<-matrix(rnorm(100*5),100,5) #Draw some covariates r1<-0.2 #Set the model parameters r2<-0.1 sigma<-0.1 beta<-rnorm(5) #Assemble y from its components: nu<-rnorm(100,0,sigma) #Draw the disturbances e<-qr.solve(diag(100)-r2*w2,nu) #Draw the effective errors y<-qr.solve(diag(100)-r1*w1,x\%*\%beta+e) #Compute y #Now, fit the autocorrelation model: fit<-lnam(y,x,w1,w2) summary(fit) plot(fit) } } \keyword{ regression }% at least one, from doc/KEYWORDS \keyword{ multivariate }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/bbnam.bf.Rd0000644000176200001440000001170611212663270013547 0ustar liggesusers\name{bbnam.bf} \alias{bbnam.bf} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Estimate Bayes Factors for the bbnam } \description{ This function uses monte carlo integration to estimate the BFs, and tests the fixed probability, pooled, and pooled by actor models. (See \code{\link{bbnam}} for details.) } \usage{ bbnam.bf(dat, nprior=0.5, em.fp=0.5, ep.fp=0.5, emprior.pooled=c(1, 11), epprior.pooled=c(1, 11), emprior.actor=c(1, 11), epprior.actor=c(1, 11), diag=FALSE, mode="digraph", reps=1000) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ Input networks to be analyzed. This may be supplied in any reasonable form, but must be reducible to an array of dimension \eqn{m \times n \times n}{m x n x n}, where \eqn{n} is \eqn{|V(G)|}, the first dimension indexes the observer (or information source), the second indexes the sender of the relation, and the third dimension indexes the recipient of the relation. (E.g., \code{dat[i,j,k]==1} implies that i observed j sending the relation in question to k.) Note that only dichotomous data is supported at present, and missing values are permitted; the data collection pattern, however, is assumed to be ignorable, and hence the posterior draws are implicitly conditional on the observation pattern.} \item{nprior}{ Network prior matrix. This must be a matrix of dimension \eqn{n} x \eqn{n}, containing the arc/edge priors for the criterion network. (E.g., \code{nprior[i,j]} gives the prior probability of \code{i} sending the relation to \code{j} in the criterion graph.) Non-matrix values will be coerced/expanded to matrix form as appropriate. If no network prior is provided, an uninformative prior on the space of networks will be assumed (i.e., \eqn{\Pr(i\to j)=0.5}{Pr(i->j)=0.5}). Missing values are not allowed. } \item{em.fp}{ Probability of false negatives for the fixed probability model } \item{ep.fp}{ Probability of false positives for the fixed probability model } \item{emprior.pooled}{ \eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the (beta) false negative prior under the pooled model } \item{epprior.pooled}{ \eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the (beta) false positive prior under the pooled model } \item{emprior.actor}{ Matrix of per observer \eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the (beta) false negative prior under the per observer/actor model, or something that can be coerced to this form } \item{epprior.actor}{ Matrix of per observer (\eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the (beta) false positive prior under the per observer/actor model, or something that can be coerced to this form } \item{diag}{ Boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the criterion graph can contain loops. Diag is false by default. } \item{mode}{ String indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. Mode is set to \code{"digraph"} by default. } \item{reps}{ Number of Monte Carlo draws to take } } \details{ The bbnam model (detailed in the \code{\link{bbnam}} function help) is a fairly simple model for integrating informant reports regarding social network data. \code{bbnam.bf} computes log Bayes Factors (integrated likelihood ratios) for the three error submodels of the bbnam: fixed error probabilities, pooled error probabilities, and per observer/actor error probabilities. By default, \code{bbnam.bf} uses weakly informative Beta(1,11) priors for false positive and false negative rates, which may not be appropriate for all cases. (Likewise, the initial network prior is uniformative.) Users are advised to consider adjusting the error rate priors when using this function in a practical context; for instance, it is often reasonable to expect higher false negative rates (on average) than false positive rates, and to expect the criterion graph density to be substantially less than 0.5. See the reference below for a discussion of this issue. } \value{ An object of class \code{bayes.factor}. } \references{ Butts, C. T. (2003). \dQuote{Network Inference, Error, and Informant (In)Accuracy: A Bayesian Approach.} \emph{Social Networks}, 25(2), 103-140. Robert, C. (1994). \emph{The Bayesian Choice: A Decision-Theoretic Motivation.} Springer. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ It is important to be aware that the model parameter priors are essential components of the models to be compared; inappropriate parameter priors will result in misleading Bayes Factors. } \seealso{ \code{\link{bbnam}} } \examples{ #Create some random data from the "pooled" model g<-rgraph(7) g.p<-0.8*g+0.2*(1-g) dat<-rgraph(7,7,tprob=g.p) #Estimate the log Bayes Factors b<-bbnam.bf(dat,emprior.pooled=c(3,5),epprior.pooled=c(3,5), emprior.actor=c(3,5),epprior.actor=c(3,5)) #Print the results b } \keyword{models} \keyword{ math } sna/man/numperm.Rd0000644000176200001440000000342110501711234013552 0ustar liggesusers\name{numperm} \alias{numperm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Get the nth Permutation Vector by Periodic Placement } \description{ \code{numperm} implicitly numbers all permutations of length \code{olength}, returning the \code{permnum}th of these. } \usage{ numperm(olength, permnum) } %- maybe also `usage' for other objects documented here. \arguments{ \item{olength}{ The number of items to permute } \item{permnum}{ The number of the permutation to use (in \code{1:olength!}) } } \details{ The n! permutations on n items can be deterministically ordered via a factorization process in which there are n slots for the first element, n-1 for the second, and n-i for the ith. This fact is quite handy if you want to visit each permutation in turn, or if you wish to sample without replacement from the set of permutations on some number of elements: one just enumerates or samples from the integers on [1,n!], and then find the associated permutation. \code{numperm} performs exactly this last operation, returning the \code{permnum}th permutation on \code{olength} items. } \value{ A permutation vector } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Permutation search is central to the estimation of structural distances, correlations, and covariances on partially labeled graphs. \code{numperm} is hence used by \code{\link{structdist}}, \code{\link{gscor}}, \code{\link{gscov}}, etc. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{rperm}}, \code{\link{rmperm}} } \examples{ #Draw a graph g<-rgraph(5) #Permute the rows and columns p.1<-numperm(5,1) p.2<-numperm(5,2) p.3<-numperm(5,3) g[p.1,p.1] g[p.2,p.2] g[p.3,p.3] } \keyword{ array }%-- one or more ... \keyword{ math } sna/man/hdist.Rd0000644000176200001440000000737711361526135013231 0ustar liggesusers\name{hdist} \alias{hdist} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Hamming Distances Between Two or More Graphs } \description{ \code{hdist} returns the Hamming distance between the labeled graphs \code{g1} and \code{g2} in set \code{dat} for dichotomous data, or else the absolute (manhattan) distance. If \code{normalize} is true, this distance is divided by its dichotomous theoretical maximum (conditional on |V(G)|). } \usage{ hdist(dat, dat2=NULL, g1=NULL, g2=NULL, normalize=FALSE, diag=FALSE, mode="digraph") } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a stack of input graphs. } \item{dat2}{ a second graph stack (optional). } \item{g1}{ a vector indicating which graphs to compare (by default, all elements of \code{dat}). } \item{g2}{ a vector indicating against which the graphs of \code{g1} should be compared (by default, all graphs). } \item{normalize}{ divide by the number of available dyads? } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } } \details{ The Hamming distance between two labeled graphs \eqn{G_1} and \eqn{G_2} is equal to \eqn{|\{e : (e \in E(G_1), e \not\in E(G_2)) \wedge (e \not\in E(G_1), e \in E(G_2))\}|}{|\{e : (e in E(G_1) and e not in E(G_2)) or (e not in E(G_1) and e in E(G_2))\}|}. In more prosaic terms, this may be thought of as the number of addition/deletion operations required to turn the edge set of \eqn{G_1} into that of \eqn{G_2}. The Hamming distance is a highly general measure of structural similarity, and forms a metric on the space of graphs (simple or directed). Users should be reminded, however, that the Hamming distance is extremely sensitive to nodal labeling, and should not be employed directly when nodes are interchangeable. The structural distance (Butts and Carley (2001)), implemented in \code{\link{structdist}}, provides a natural generalization of the Hamming distance to the more general case of unlabeled graphs. Null hypothesis testing for Hamming distances is available via \code{\link{cugtest}}, and \code{\link{qaptest}}; graphs which minimize the Hamming distances to all members of a graph set can be found by \code{\link{centralgraph}}. For an alternative means of comparing the similarity of graphs, consider \code{\link{gcor}}. } \value{ A matrix of Hamming distances } \references{ Banks, D., and Carley, K.M. (1994). \dQuote{Metric Inference for Social Networks.} \emph{Journal of Classification}, 11(1), 121-49. Butts, C.T. and Carley, K.M. (2005). \dQuote{Some Simple Algorithms for Structural Comparison.} \emph{Computational and Mathematical Organization Theory,} 11(4), 291-305. Butts, C.T., and Carley, K.M. (2001). \dQuote{Multivariate Methods for Interstructural Analysis.} CASOS Working Paper, Carnegie Mellon University. Hamming, R.W. (1950). \dQuote{Error Detecting and Error Correcting Codes.} \emph{Bell System Technical Journal,} 29, 147-160. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ For non-dichotomous data, the distance which is returned is simply the sum of the absolute edge-wise differences. } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{sdmat}}, \code{\link{structdist}} } \examples{ #Get some random graphs g<-rgraph(5,5,tprob=runif(5,0,1)) #Find the Hamming distances hdist(g) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ graphs } sna/man/rgnm.Rd0000644000176200001440000000472511176525664013065 0ustar liggesusers\name{rgnm} \alias{rgnm} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Draw Density-Conditioned Random Graphs } \description{ \code{rgnm} generates random draws from a density-conditioned uniform random graph distribution. } \usage{ rgnm(n, nv, m, mode = "digraph", diag = FALSE, return.as.edgelist = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{ the number of graphs to generate. } \item{nv}{ the size of the vertex set (\eqn{|V(G)|}) for the random graphs. } \item{m}{ the number of edges on which to condition. } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} for undirected graphs. } \item{diag}{ logical; should loops be allowed? } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in edgelist form?} } \details{ \code{rgnm} returns draws from the density-conditioned uniform random graph first popularized by the famous work of Erdos and Renyi (the \eqn{G(N,M)} process). In particular, the pmf of a \eqn{G(N,M)} process is given by \deqn{ p(G=g|N,M) = \left( {E_m \atop M} \right)^{-1} }{% p(G=g|N,M) = 1/Choose(E_m,M) } where \eqn{E_m} is the maximum number of edges in the graph. (\eqn{E_m} is equal to \code{nv*(nv-diag)/(1+(mode=="graph"))}.) The \eqn{G(N,M)} process is one of several process which are used as baseline models of social structure. Other well-known baseline models include the Bernoulli graph (the \eqn{G(N,p)} model of Erdos and Renyi) and the U|MAN model of dyadic independence. These are implemented within \code{sna} as \code{\link{rgraph}} and \code{\link{rgnm}}, respectively. } \value{ A matrix or array containing the drawn adjacency matrices } \references{ Erdos, P. and Renyi, A. (1960). \dQuote{On the Evolution of Random Graphs.} \emph{Public Mathematical Institute of Hungary Academy of Sciences,} 5:17-61. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The famous mathematicians referenced in this man page now have misspelled names, due to R's difficulty with accent marks. } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{rgraph}}, \code{\link{rguman}} } \examples{ #Draw 5 random graphs of order 10 all(gden(rgnm(5,10,9,mode="graph"))==0.2) #Density 0.2 all(gden(rgnm(5,10,9))==0.1) #Density 0.1 #Plot a random graph gplot(rgnm(1,10,20)) } \keyword{ distribution }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/print.summary.netlogit.Rd0000644000176200001440000000137111176541676016571 0ustar liggesusers\name{print.summary.netlogit} \alias{print.summary.netlogit} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.netlogit Objects } \description{ Prints an object of class \code{summary.netlogit}. } \usage{ \method{print}{summary.netlogit}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.netlogit}~ } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.netlogit}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/nacf.Rd0000644000176200001440000001247111176457012013015 0ustar liggesusers\name{nacf} \alias{nacf} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Sample Network Covariance and Correlation Functions } \description{ \code{nacf} computes the sample network covariance/correlation function for a specified variable on a given input network. Moran's \eqn{I} and Geary's \eqn{C} statistics at multiple orders may be computed as well. } \usage{ nacf(net, y, lag.max = NULL, type = c("correlation", "covariance", "moran", "geary"), neighborhood.type = c("in", "out", "total"), partial.neighborhood = TRUE, mode = "digraph", diag = FALSE, thresh = 0, demean = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{net}{ one or more graphs. } \item{y}{ a numerical vector, of length equal to the order of \code{net}. } \item{lag.max}{ optionally, the maximum geodesic lag at which to compute dependence (defaults to order \code{net}-1). } \item{type}{ the type of dependence statistic to be computed. } \item{neighborhood.type}{ the type of neighborhood to be employed when assessing dependence (as per \code{\link{neighborhood}}). } \item{partial.neighborhood}{ logical; should partial (rather than cumulative) neighborhoods be employed at higher orders? } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} if \code{net} is undirected. } \item{diag}{ logical; does the diagonal of \code{net} contain valid data?} \item{thresh}{ threshold at which to dichotomize \code{net}. } \item{demean}{ logical; demean \code{y} prior to analysis? } } \details{ \code{nacf} computes dependence statistics for the vector \code{y} on network \code{net}, for neighborhoods of various orders. Specifically, let \eqn{\mathbf{A}_i}{A_i} be the \eqn{i}th order adjacency matrix of \code{net}. The sample network autocovariance of \eqn{\mathbf{y}}{y} on \eqn{\mathbf{A}_i}{A_i} is then given by \deqn{ \sigma_i = \frac{\mathbf{y}^T \mathbf{A}_i \mathbf{y}}{E}, }{% sigma_i = y^T A_i y / E, } where \eqn{E=\sum_{(j,k)}A_{ijk}}{E = sum(A_i)}. Similarly, the sample network autocorrelation in the above case is \eqn{\rho_i=\sigma_i/\sigma_0}{sigma_i/sigma_0}, where \eqn{\sigma_0}{sigma_0} is the variance of \eqn{y}. Moran's \eqn{I} and Geary's \eqn{C} statistics are defined in the usual fashion as \deqn{ I_i = \frac{N \sum_{j=1}^N \sum_{k=1}^N (y_j-\bar{y}) (y_k-\bar{y}) A_{ijk}}{E \sum_{j=1}^N y_j^2}, }{% I_i = N/E * ((y-ybar)^T A_i (y-ybar))/sum(y^2), } and \deqn{ C_i = \frac{(N-1) \sum_{j=1}^N \sum_{k=1}^N (y_j-y_k)^2 A_{ijk}}{2 E \sum_{j=1}^N (y-\bar{y})^2} }{% C_i = (N-1)/(2E) * (sum_jk (y_j-y_k)^2 A_ijk) / sum((y-ybar)^2) } respectively, where \eqn{N} is the order of \eqn{\mathbf{A}_i}{A_i} and \eqn{\bar{y}}{ybar} is the mean of \eqn{\mathbf{y}}{y}. The adjacency matrix associated with the \eqn{i}th order neighborhood is defined as the identity matrix for order 0, and otherwise depends on the type of neighborhood involved. For input graph \eqn{G=(V,E)}, let the \emph{base relation}, \eqn{R}, be given by the underlying graph of \eqn{G} (i.e., \eqn{G \cup G^T}{G U G^T}) if total neighborhoods are sought, the transpose of \eqn{G} if incoming neighborhoods are sought, or \eqn{G} otherwise. The partial neighborhood structure of order \eqn{i>0} on \eqn{R} is then defined to be the digraph on \eqn{V} whose edge set consists of the ordered pairs \eqn{(j,k)} having geodesic distance \eqn{i} in \eqn{R}. The corresponding cumulative neighborhood is formed by the ordered pairs having geodesic distance less than or equal to \eqn{i} in \eqn{R}. For purposes of \code{nacf}, these neighborhoods are calculated using \code{\link{neighborhood}}, with the specified parameters (including dichotomization at \code{thresh}). The return value for \code{nacf} is the selected dependence statistic, calculated for each neighborhood structure from order 0 (the identity) through order \code{lag.max} (or \eqn{N-1}, if \code{lag.max==NULL}). This vector can be used much like the conventional autocorrelation function, to identify dependencies at various lags. This may, in turn, suggest a starting point for modeling via routines such as \code{\link{lnam}}. } \value{ A vector containing the dependence statistics (ascending from order 0). } \references{ Geary, R.C. (1954). \dQuote{The Contiguity Ratio and Statistical Mapping.} \emph{The Incorporated Statistician,} 5: 115-145. Moran, P.A.P. (1950). \dQuote{Notes on Continuous Stochastic Phenomena.} \emph{Biometrika,} 37: 17-23. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ % % ~Make other sections like Warning with \section{Warning }{....} ~ %} \seealso{ \code{\link{geodist}}, \code{\link{gapply}}, \code{\link{neighborhood}}, \code{\link{lnam}}, \code{\link{acf}}} \examples{ #Create a random graph, and an autocorrelated variable g<-rgraph(50,tp=4/49) y<-qr.solve(diag(50)-0.8*g,rnorm(50,0,0.05)) #Examine the network autocorrelation function nacf(g,y) #Partial neighborhoods nacf(g,y,partial.neighborhood=FALSE) #Cumulative neighborhoods #Repeat, using Moran's I on the underlying graph nacf(g,y,type="moran") nacf(g,y,partial.neighborhood=FALSE,type="moran") } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ multivariate }% __ONLY ONE__ keyword per line sna/man/plot.blockmodel.Rd0000644000176200001440000000340211176527405015174 0ustar liggesusers\name{plot.blockmodel} \alias{plot.blockmodel} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plotting for blockmodel Objects } \description{ Displays a plot of the blocked data matrix, given a blockmodel object. } \usage{ \method{plot}{blockmodel}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{blockmodel} } \item{\dots}{ Further arguments passed to or from other methods } } \details{ Plots of the blocked data matrix (i.e., the data matrix with rows and columns permuted to match block membership) can be useful in assessing the strength of the block solution (particularly for clique detection and/or regular equivalence). } \value{ None } \references{ White, H.C.; Boorman, S.A.; and Breiger, R.L. (1976). ``Social Structure from Multiple Networks I: Blockmodels of Roles and Positions.'' \emph{American Journal of Sociology}, 81, 730-779. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{blockmodel}}, \code{\link{plot.sociomatrix}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Cluster based on structural equivalence eq<-equiv.clust(g) #Form a blockmodel with distance relaxation of 10 b<-blockmodel(g,eq,h=10) plot(b) #Plot it } \keyword{ hplot }%-- one or more ... sna/man/cugtest.Rd0000644000176200001440000001441511212710023013545 0ustar liggesusers\name{cugtest} \alias{cugtest} %- Also NEED an `\alias' for EACH other topic documented here. \title{Perform Conditional Uniform Graph (CUG) Hypothesis Tests for Graph-Level Indices} \description{ \code{cugtest} tests an arbitrary GLI (computed on \code{dat} by \code{FUN}) against a conditional uniform graph null hypothesis, via Monte Carlo simulation. Some variation in the nature of the conditioning is available; currently, conditioning only on size, conditioning jointly on size and estimated tie probability (via expected density), and conditioning jointly on size and (bootstrapped) edge value distributions are implemented. Note that fair amount of flexibility is possible regarding CUG tests on functions of GLIs (Anderson et al., 1999). See below for more details. } \usage{ cugtest(dat, FUN, reps=1000, gmode="digraph", cmode="density", diag=FALSE, g1=1, g2=2, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ graph(s) to be analyzed. } \item{FUN}{ function to compute GLIs, or functions thereof. \code{FUN} must accept \code{dat} and the specified \code{g} arguments, and should return a real number. } \item{reps}{ integer indicating the number of draws to use for quantile estimation. Note that, as for all Monte Carlo procedures, convergence is slower for more extreme quantiles. By default, \code{reps==1000}. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{gmode} is set to "digraph" by default. } \item{cmode}{ string indicating the type of conditioning assumed by the null hypothesis. If \code{cmode} is set to "density", then the density of the graph in question is used to determine the tie probabilities of the Bernoulli graph draws (which are also conditioned on |V(G)|). If\code{cmode=="ties"}, then draws are bootstrapped from the distribution of edge values within the data matrices. If \code{cmode="order"}, then draws are uniform over all graphs of the same order (size) as the graphs within the input stack. By default, \code{cmode} is set to \code{"density"}.} \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{g1}{ integer indicating the index of the first graph input to the GLI. By default, \code{g1==1}. } \item{g2}{ integer indicating the index of the second graph input to the GLI. (\code{FUN} can ignore this, if one wishes to test the GLI value of a single graph, but it should recognize the argument.) By default, \code{g2==2}. } \item{\dots}{ additional arguments to \code{FUN}. } } \details{ The null hypothesis of the CUG test is that the observed GLI (or function thereof) was drawn from a distribution equivalent to that of said GLI evaluated (uniformly) on the space of all graphs conditional on one or more features. The most common \dQuote{features} used for conditioning purposes are order (size) and density, both of which are known to have strong and nontrivial effects on other GLIs (Anderson et al., 1999) and which are, in many cases, exogenously determined. (Note that maximum entropy distributions conditional on expected statistics are not in general correctly referred to as \dQuote{conditional uniform graphs}, but have been described as such for independent-dyad models; this is indeed the case for this function, although such terminology is not really proper. See \code{\link{cug.test}} for CUG tests with exact conditioning.) Since theoretical results regarding functions of arbitrary GLIs on the space of graphs are not available, the standard approach to CUG testing is to approximate the quantiles of the observed statistic associated with the null hypothesis using Monte Carlo methods. This is the technique utilized by \code{cugtest}, which takes appropriately conditioned draws from the set of graphs and computes on them the GLI specified in \code{FUN}, thereby accumulating an approximation to the true quantiles. The \code{cugtest} procedure returns a \code{cugtest} object containing the estimated distribution of the test GLI under the null hypothesis, the observed GLI value of the data, and the one-tailed p-values (estimated quantiles) associated with said observation. As usual, the (upper tail) null hypothesis is rejected for significance level alpha if p>=observation is less than alpha (or p<=observation, for the lower tail). Standard caveats regarding the use of null hypothesis testing procedures are relevant here: in particular, bear in mind that a significant result does not necessarily imply that the likelihood ratio of the null model and the alternative hypothesis favors the latter. Informative and aesthetically pleasing portrayals of \code{cugtest} objects are available via the \code{\link{print.cugtest}} and \code{\link{summary.cugtest}} methods. The \code{\link{plot.cugtest}} method displays the estimated distribution, with a reference line signifying the observed value. } \value{ An object of class \code{cugtest}, containing \item{testval}{ The observed GLI value. } \item{dist}{ A vector containing the Monte Carlo draws. } \item{pgreq}{ The proportion of draws which were greater than or equal to the observed GLI value. } \item{pleeq}{ The proportion of draws which were less than or equal to the observed GLI value. } } \references{ Anderson, B.S.; Butts, C.T.; and Carley, K.M. (1999). \dQuote{The Interaction of Size and Density with Graph-Level Indices.} \emph{Social Networks}, 21(3), 239-267. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{This function currently conditions only on expected statistics, and is somewhat cumbersome. \code{\link{cug.test}} is now recommended for univariate CUG tests (and will eventually supplant this function).} \seealso{ \code{\link{cug.test}}, \code{\link{qaptest}}, \code{\link{gliop}} } \examples{ #Draw two random graphs, with different tie probabilities dat<-rgraph(20,2,tprob=c(0.2,0.8)) #Is their correlation higher than would be expected, conditioning #only on size? cug<-cugtest(dat,gcor,cmode="order") summary(cug) #Now, let's try conditioning on density as well. cug<-cugtest(dat,gcor) summary(cug) } \keyword{htest} \keyword{ math } \keyword{ graphs } sna/man/print.summary.bbnam.Rd0000644000176200001440000000150111176542047016007 0ustar liggesusers\name{print.summary.bbnam} \alias{print.summary.bbnam} \alias{print.summary.bbnam.fixed} \alias{print.summary.bbnam.pooled} \alias{print.summary.bbnam.actor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.bbnam Objects } \description{ Prints an object of class \code{summary.bbnam}. } \usage{ \method{print}{summary.bbnam}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.bbnam} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/event2dichot.Rd0000644000176200001440000000423210501711235014467 0ustar liggesusers\name{event2dichot} \alias{event2dichot} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Convert an Observed Event Matrix to a Dichotomous matrix } \description{ Given one or more valued adjacency matrices (possibly derived from observed interaction ``events''), \code{event2dichot} returns dichotomized equivalents. } \usage{ event2dichot(m, method="quantile", thresh=0.5, leq=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{m}{ one or more (valued) input graphs. } \item{method}{ one of ``quantile,'' ``rquantile,'' ``cquantile,'' ``mean,'' ``rmean,'' ``cmean,'' ``absolute,'' ``rank,'' ``rrank,'' or ``crank''. } \item{thresh}{ dichotomization thresholds for ranks or quantiles. } \item{leq}{ boolean indicating whether values less than or equal to the threshold should be taken as existing edges; the alternative is to use values strictly greater than the threshold. } } \details{ The methods used for choosing dichotomization thresholds are as follows: \enumerate{ \item quantile: specified quantile over the distribution of all edge values \item rquantile: specified quantile by row \item cquantile: specified quantile by column \item mean: grand mean \item rmean: row mean \item cmean: column mean \item absolute: the value of \code{thresh} itself \item rank: specified rank over the distribution of all edge values \item rrank: specified rank by row \item crank: specified rank by column } Note that when a quantile, rank, or value is said to be ``specified,'' this refers to the value of \code{thresh}. } \value{ The dichotomized data matrix (or matrices) } \references{ Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #Draw a matrix of normal values n<-matrix(rnorm(25),nrow=5,ncol=5) #Dichotomize by the mean value event2dichot(n,"mean") #Dichotomize by the 0.95 quantile event2dichot(n,"quantile",0.95) } \keyword{ manip }%-- one or more ... \keyword{ math } sna/man/diag.remove.Rd0000644000176200001440000000177310501711235014300 0ustar liggesusers\name{diag.remove} \alias{diag.remove} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Remove the Diagonals of Adjacency Matrices in a Graph Stack } \description{ Returns the input graphs, with the diagonal entries removed/replaced as indicated. } \usage{ diag.remove(dat, remove.val=NA) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{remove.val}{ the value with which to replace the existing diagonals } } \details{ \code{diag.remove} is simply a convenient way to apply \code{\link{diag}} to an entire collection of adjacency matrices/\code{network} objects at once. } \value{ The updated graphs. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{diag}}, \code{\link{upper.tri.remove}}, \code{\link{lower.tri.remove}} } \examples{ #Generate a random graph stack g<-rgraph(3,5) #Remove the diagonals g<-diag.remove(g) } \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/consensus.Rd0000644000176200001440000001243110501711235014111 0ustar liggesusers\name{consensus} \alias{consensus} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Estimate a Consensus Structure from Multiple Observations } \description{ \code{consensus} estimates a central or consensus structure given multiple observations, using one of several algorithms. } \usage{ consensus(dat, mode="digraph", diag=FALSE, method="central.graph", tol=1e-06, maxiter=1e3, verbose=TRUE, no.bias=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a set of input graphs (must have same order). } \item{mode}{ \code{"digraph"} for directed data, else \code{"graph"}. } \item{diag}{ logical; should diagonals (loops) be treated as data? } \item{method}{ one of \code{"central.graph"}, \code{"single.reweight"}, \code{"iterative.reweight"}, \code{"romney.batchelder"}, \code{"PCA.reweight"}, \code{"LAS.intersection"}, \code{"LAS.union"}, \code{"OR.row"}, or \code{"OR.col"}. } \item{tol}{ convergence tolerance for the iterative reweighting and B-R algorithms.} \item{maxiter}{ maximum number of iterations to take (regardless of convergence) for the iterative reweighting and B-R algorithms.} \item{verbose}{ logical; should bias and competency parameters be reported (where computed)?} \item{no.bias}{ logical; should responses be assumed to be unbiased? } } \details{ The term ``consensus structure'' is used by a number of authors to reflect a notion of shared or common perceptions of social structure among a set of observers. As there are many interpretations of what is meant by ``consensus'' (and as to how best to estimate it), several algorithms are employed here: \enumerate{ \item \code{central.graph}: Estimate the consensus structure using the central graph. This corresponds to a ``median response'' notion of consensus. \item \code{single.reweight}: Estimate the consensus structure using subject responses, reweighted by mean graph correlation. This corresponds to an ``expertise-weighted vote'' notion of consensus. \item \code{iterative.reweight}: Similar to \code{single.reweight}, but the consensus structure and accuracy parameters are estimated via an iterated proportional fitting scheme. The implementation employed here uses both bias and competency parameters. \item \code{romney.batchelder}: Fits a Romney-Batchelder informant accuracy model using IPF. This is very similar to \code{iterative.reweight}, but can be interpreted as the result of a process in which each informant report is correct with a probability equal to the informant's competency score, and otherwise equal to a Bernoulli trial with parameter equal to the informant's bias score. \item \code{PCA.reweight}: Estimate the consensus using the (scores on the) first component of a network PCA. This corresponds to a ``shared theme'' or ``common element'' notion of consensus. \item \code{LAS.intersection}: Estimate the consensus structure using the locally aggregated structure (intersection rule). In this model, an i->j edge exists iff i \emph{and} j agree that it exists. \item \code{LAS.union}: Estimate the consensus structure using the locally aggregated structure (union rule). In this model, an i->j edge exists iff i \emph{or} j agree that it exists. \item \code{OR.row}: Estimate the consensus structure using own report. Here, we take each informant's outgoing tie reports to be correct. \item \code{OR.col}: Estimate the consensus structure using own report. Here, we take each informant's incoming tie reports to be correct. } Note that the results returned by the single weighting algorithms are not dichotomized by default; since some algorithms thus return valued graphs, dichotomization may be desirable prior to use. It should be noted that a model for estimating an underlying criterion structure from multiple informant reports is provided in \code{\link{bbnam}}; if your goal is to reconstruct an ``objective'' network from informant reports, this (or the R-B model) may prove more useful than the ad-hoc solutions. } \value{ An adjacency matrix representing the consensus structure } \references{ Banks, D.L., and Carley, K.M. (1994). ``Metric Inference for Social Networks.'' \emph{Journal of Classification,} 11(1), 121-49. Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Inter-Structural Analysis.'' CASOS Working Paper, Carnegie Mellon University. Krackhardt, D. (1987). ``Cognitive Social Structures.'' \emph{Social Networks,} 9, 109-134. Romney, A.K.; Weller, S.C.; and Batchelder, W.H. (1986). ``Culture as Consensus: A Theory of Culture and Informant Accuracy.'' \emph{American Anthropologist,} 88(2), 313-38. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ Eventually, this routine will also support the (excellent) consensus methods of Romney and Batchelder; since these are similar in many respects to the \code{\link{bbnam}} model, users may wish to try this alternative for now. %} \seealso{ \code{\link{bbnam}}, \code{\link{centralgraph}} } \examples{ #Generate some test data g<-rgraph(5) g.pobs<-g*0.9+(1-g)*0.5 g.obs<-rgraph(5,5,tprob=g.pobs) #Find some consensus structures consensus(g.obs) #Central graph consensus(g.obs,method="single.reweight") #Single reweighting consensus(g.obs,method="PCA.reweight") #1st component in network PCA } \keyword{ graphs }%-- one or more ... sna/man/grecip.Rd0000644000176200001440000000672211601651131013350 0ustar liggesusers\name{grecip} \alias{grecip} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Reciprocity of an Input Graph or Graph Stack } \description{ \code{grecip} calculates the dyadic reciprocity of the elements of \code{dat} selected by \code{g}. } \usage{ grecip(dat, g = NULL, measure = c("dyadic", "dyadic.nonnull", "edgewise", "edgewise.lrr", "correlation")) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ a vector indicating which graphs to evaluate (optional). } \item{measure}{ one of \code{"dyadic"} (default), \code{"dyadic.nonnull"}, \code{"edgewise"}, \code{"edgewise.lrr"}, or \code{"correlation"}. } } \details{ The dyadic reciprocity of a graph is the proportion of dyads which are symmetric; this is computed and returned by \code{grecip} for the graphs indicated. (\code{dyadic.nonnull} returns the ratio of mutuals to non-null dyads.) Note that the dyadic reciprocity is distinct from the \emph{edgewise} or \emph{tie reciprocity}, which is the proportion of \emph{edges} which are reciprocated. This latter form may be obtained by setting \code{measure="edgewise"}. Setting \code{measure="edgewise.lrr"} returns the log of the ratio of the edgewise reciprocity to the density; this is measure (called \eqn{r_4} by Butts (2008)) can be interpreted as the relative log-odds of an edge given a reciprocation, versus the baseline probability of an edge. Finally, \code{measure="correlation"} returns the correlation between within-dyad edge values, where this is defined by \deqn{\frac{2\sum_{\{i,j\}} (Y_{ij}-\mu_G)(Y_{ji}-\mu_G)}{(2N_d-1) \sigma^2_G}}{% 2*(sum_{i,j} (Y_ij-mu_G)*(Y_ji-mu_G))/((2*N_d-1)*sigma^2_G) } with \eqn{Y} being the graph adjacency matrix, \eqn{\mu_G}{mu_G} being the mean non-loop edge value, \eqn{\sigma^2_G}{sigma^2_G} being the variance of non-loop edge values, and \eqn{N_d} being the number of dyads. (Note that this quantity is unaffected by dyad orientation.) The correlation measure may be interpreted as the net tendency for edges of similar relative value (with respect to the mean edge value) to occur within the same dyads. For dichotomous data, adjacencies are interpreted as having values of 0 (no edge present) or 1 (edge present), but edge values are used where supplied. In cases where all edge values are identical (e.g., the complete or empty graph), the correlation reciprocity is taken to be 1 by definition. Note that \code{grecip} calculates values based on non-missing data; dyads containing missing data are removed from consideration when calculating reciprocity scores (except for the correlation measure, which uses non-missing edges within missing dyads when calculating the graph mean and variance). } \value{ The graph reciprocity value(s) } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. Butts, C.T. (2008). \dQuote{Social Networks: A Methodological Introduction.} \emph{Asian Journal of Social Psychology,} 11(1), 13-41. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{mutuality}}, \code{\link{symmetrize}} } \examples{ #Calculate the dyadic reciprocity scores for some random graphs grecip(rgraph(10,5)) } \keyword{ math }%-- one or more ... \keyword{ univar }%-- one or more ... \keyword{ graphs } sna/man/blockmodel.expand.Rd0000644000176200001440000000475110501711235015470 0ustar liggesusers\name{blockmodel.expand} \alias{blockmodel.expand} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generate a Graph (or Stack) from a Given Blockmodel Using Particular Expansion Rules } \description{ \code{blockmodel.expand} takes a blockmodel and an expansion vector, and expands the former by making copies of the vertices. } \usage{ blockmodel.expand(b, ev, mode="digraph", diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{b}{ blockmodel object. } \item{ev}{ a vector indicating the number of copies to make of each class (respectively). } \item{mode}{ a string indicating whether the result should be a ``graph'' or ``digraph''. } \item{diag}{ a boolean indicating whether or not loops should be permitted. } } \details{ The primary use of blockmodel expansion is in generating test data from a blockmodeling hypothesis. Expansion is performed depending on the content type of the blockmodel; at present, only density is supported. For the density content type, expansion is performed by interpreting the interclass density as an edge probability, and by drawing random graphs from the Bernoulli parameter matrix formed by expanding the density model. Thus, repeated calls to \code{blockmodel.expand} can be used to generate a sample for monte carlo null hypothesis tests under a Bernoulli graph model. } \value{ An adjacency matrix, or stack thereof. } \references{ Doreian, P.; Batagelj, V.; and Ferligoj, A. (2005). \emph{Generalized Blockmodeling.} Cambridge: Cambridge University Press. White, H.C.; Boorman, S.A.; and Breiger, R.L. (1976). ``Social Structure from Multiple Networks I: Blockmodels of Roles and Positions.'' \emph{American Journal of Sociology}, 81, 730-779. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Eventually, other content types will be supported. } \seealso{ \code{\link{blockmodel}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Cluster based on structural equivalence eq<-equiv.clust(g) #Form a blockmodel with distance relaxation of 15 b<-blockmodel(g,eq,h=15) #Draw from an expanded density blockmodel g.e<-blockmodel.expand(b,rep(2,length(b$rlabels))) #Two of each class g.e } \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs} sna/man/print.summary.cugtest.Rd0000644000176200001440000000136111176542003016402 0ustar liggesusers\name{print.summary.cugtest} \alias{print.summary.cugtest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.cugtest Objects } \description{ Prints an object of class \code{summary.cugtest}. } \usage{ \method{print}{summary.cugtest}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.cugtest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.cugtest}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/sna-defunct.Rd0000644000176200001440000000237711176535644014331 0ustar liggesusers\name{sna-defunct} \alias{addisolates} \alias{addisolates-defunct} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Defunct sna Objects } \description{ These objects have been removed from \code{sna}, and should no longer be used. } \usage{ addisolates(dat, n) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ One or more adjacency matrices } \item{n}{ The number of isolates to add } } %\details{ % If \code{dat} contains more than one adjacency matrix, the \code{n} isolates %are added to each member of \code{dat}. %} %\value{ % The updated graph stack. %} %\references{ Butts, C.T., and Carley, K.M. (2001). \dQuote{Multivariate Methods for Inter-Structural Analysis.} CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ Isolate addition is particularly useful when computing structural distances between graphs of different orders; see the above reference for details. } %\seealso{ \code{\link{isolates}} } % %\examples{ % %g<-rgraph(10,5) #Produce some random graphs % %dim(g) #Get the dimensions of g % %\dontrun{g<-addisolates(g,2)} #Add 2 isolates to each graph in g % %dim(g) #Now examine g %g % %} \keyword{ internal } %\keyword{ math } sna/man/print.bbnam.Rd0000644000176200001440000000142011176542230014305 0ustar liggesusers\name{print.bbnam} \alias{print.bbnam} \alias{print.bbnam.fixed} \alias{print.bbnam.pooled} \alias{print.bbnam.actor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for bbnam Objects } \description{ Prints a quick summary of posterior draws from \code{\link{bbnam}}. } \usage{ \method{print}{bbnam}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ A \code{\link{bbnam}} object } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ None } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/equiv.clust.Rd0000644000176200001440000000651710501711235014363 0ustar liggesusers\name{equiv.clust} \alias{equiv.clust} \alias{print.equiv.clust} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find Clusters of Positions Based on an Equivalence Relation } \description{ \code{equiv.clust} uses a definition of approximate equivalence (\code{equiv.fun}) to form a hierarchical clustering of network positions. Where \code{dat} consists of multiple relations, all specified relations are considered jointly in forming the equivalence clustering. } \usage{ equiv.clust(dat, g=NULL, equiv.dist=NULL, equiv.fun="sedist", method="hamming", mode="digraph", diag=FALSE, cluster.method="complete", glabels=NULL, plabels=NULL, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{g}{ the elements of \code{dat} to use in clustering the vertices; by default, all structures are used. } \item{equiv.dist}{ a matrix of distances, by which vertices should be clustered. (Overrides \code{equiv.fun}.) } \item{equiv.fun}{ the distance function to use in clustering vertices (defaults to \code{\link{sedist}}). } \item{method}{ \code{method} parameter to be passed to \code{equiv.fun}. } \item{mode}{ ``graph'' or ``digraph,'' as appropriate. } \item{diag}{ a boolean indicating whether or not matrix diagonals (loops) should be interpreted as useful data. } \item{cluster.method}{ the hierarchical clustering method to use (see \code{\link{hclust}}). } \item{glabels}{ labels for the various graphs in \code{dat}. } \item{plabels}{ labels for the vertices of \code{dat}. } \item{\dots}{ additional arguments to \code{equiv.dist}. } } \details{ This routine is essentially a joint front-end to \code{\link{hclust}} and various positional distance functions, though it defaults to structural equivalence in particular. Taking the specified graphs as input, \code{equiv.clust} computes the distances between all pairs of positions using \code{equiv.fun} (unless distances are supplied in \code{equiv.dist}), and then performs a cluster analysis of the result. The return value is an object of class \code{equiv.clust}, for which various secondary analysis methods exist. } \value{ An object of class \code{equiv.clust} } \references{ Breiger, R.L.; Boorman, S.A.; and Arabie, P. (1975). ``An Algorithm for Clustering Relational Data with Applications to Social Network Analysis and Comparison with Multidimensional Scaling.'' \emph{Journal of Mathematical Psychology}, 12, 328-383. Burt, R.S. (1976). ``Positions in Networks.'' \emph{Social Forces}, 55, 93-122. Wasserman, S., and Faust, K. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ See \code{\link{sedist}} for an example of a distance function compatible with \code{equiv.clust}. } %\section{Requires}{\code{mva}} \seealso{ \code{\link{sedist}}, \code{\link{blockmodel}}} \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Cluster based on structural equivalence eq<-equiv.clust(g) plot(eq) } \keyword{ cluster }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/graphcent.Rd0000644000176200001440000000667111176513123014062 0ustar liggesusers\name{graphcent} \alias{graphcent} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the (Harary) Graph Centrality Scores of Network Positions } \description{ \code{graphcent} takes one or more graphs (\code{dat}) and returns the Harary graph centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, graph centrality on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ graphcent(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, cmode="directed", geodist.precomp=NULL, rescale=FALSE, ignore.eval) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g==1}. } \item{nodes}{ list indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{gmode} is set to "digraph" by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{cmode}{ string indicating the type of graph centrality being computed (directed or undirected geodesics). } \item{geodist.precomp}{ a \code{\link{geodist}} object precomputed for the graph to be analyzed (optional) } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; should edge values be ignored when calculating geodesics?} } \details{ The Harary graph centrality of a vertex v is equal to \eqn{\frac{1}{\max_u d(v,u)}}{1/(max_u d(v,u))}, where \eqn{d(v,u)}{d(v,u)} is the geodesic distance from v to u. Vertices with low graph centrality scores are likely to be near the ``edge'' of a graph, while those with high scores are likely to be near the ``middle.'' Compare this with \code{\link{closeness}}, which is based on the reciprocal of the sum of distances to all other vertices (rather than simply the maximum). } \value{ A vector, matrix, or list containing the centrality scores (depending on the number and size of the input graphs). } \references{ Hage, P. and Harary, F. (1995). ``Eccentricity and Centrality in Networks.'' \emph{Social Networks}, 17:57-63. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Judicious use of \code{geodist.precomp} can save a great deal of time when computing multiple path-based indices on the same network. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{centralization}} } \examples{ g<-rgraph(10) #Draw a random graph with 10 members graphcent(g) #Compute centrality scores } \keyword{ univar }%-- one or more ... \keyword{ math } sna/man/eval.edgeperturbation.Rd0000644000176200001440000000377510501711235016375 0ustar liggesusers\name{eval.edgeperturbation} \alias{eval.edgeperturbation} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Effects of Single-Edge Perturbations on Structural Indices } \description{ Evaluates a given function on an input graph with and without a specified edge, returning the difference between the results in each case. } \usage{ eval.edgeperturbation(dat, i, j, FUN, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ A single adjacency matrix } \item{i}{ The row(s) of the edge(s) to be perturbed } \item{j}{ The column(s) of the edge(s) to be perturbed } \item{FUN}{ The function to be computed } \item{\dots}{ Additional arguments to \code{FUN} } } \details{ Although primarily a back-end utility for \code{\link{pstar}}, \code{eval.edgeperturbation} may be useful in any circumstance in which one wishes to assess the stability of a given structural index with respect to single edge perturbations. The function to be evaluated is calculated first on the input graph with all marked edges set to present, and then on the same graph with said edges absent. (Obviously, this is sensible only for dichotomous data.) The difference is then returned. In \code{\link{pstar}}, calls to \code{eval.edgeperturbation} are used to construct a perturbation effect matrix for the GLM. } \value{ The difference in the values of \code{FUN} as computed on the perturbed graphs. } \references{ Anderson, C.; Wasserman, S.; and Crouch, B. (1999). ``A p* Primer: Logit Models for Social Networks. \emph{Social Networks,} 21,37-66. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ \code{length(i)} and \code{length(j)} must be equal; where multiple edges are specified, the row and column listings are interpreted as pairs. } \seealso{ \code{\link{pstar}} } \examples{ #Create a random graph g<-rgraph(5) #How much does a one-edge change affect reciprocity? eval.edgeperturbation(g,1,2,grecip) } \keyword{ math }%-- one or more ... \keyword{ graphs } sna/man/gapply.Rd0000644000176200001440000000573211176530327013405 0ustar liggesusers\name{gapply} \alias{gapply} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Apply Functions Over Vertex Neighborhoods } \description{ Returns a vector or array or list of values obtained by applying a function to vertex neighborhoods of a given order. } \usage{ gapply(X, MARGIN, STATS, FUN, ..., mode = "digraph", diag = FALSE, distance = 1, thresh = 0, simplify = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{X}{ one or more input graphs. } \item{MARGIN}{ a vector giving the ``margin'' of \code{X} to be used in calculating neighborhoods. 1 indicates rows (out-neighbors), 2 indicates columns (in-neighbors), and c(1,2) indicates rows and columns (total neighborhood). } \item{STATS}{ the vector or matrix of vertex statistics to be used. } \item{FUN}{ the function to be applied. In the case of operators, the function name must be quoted. } \item{\dots}{ additional arguments to \code{FUN}. } \item{mode}{ \code{"graph"} if \code{X} is a simple graph, else \code{"digraph"}. } \item{diag}{ boolean; are the diagonals of \code{X} meaningful? } \item{distance}{ the maximum geodesic distance at which neighborhoods are to be taken. 1 signifies first-order neighborhoods, 2 signifies second-order neighborhoods, etc. } \item{thresh}{ the threshold to be used in dichotomizing \code{X}. } \item{simplify}{ boolean; should we attempt to coerce output to a vector if possible? } } \details{ For each vertex in \code{X}, \code{gapply} first identifies all members of the relevant neighborhood (as determined by \code{MARGIN} and \code{distance}) and pulls the rows of \code{STATS} associated with each. \code{FUN} is then applied to this collection of values. This provides a very quick and easy way to answer questions like: \itemize{ \item How many persons are in each ego's 3rd-order neighborhood? \item What fraction of each ego's alters are female? \item What is the mean income for each ego's trading partners? \item etc. } With clever use of \code{FUN} and \code{STATS}, a wide range of functionality can be obtained. } \value{ The result of the iterated application of \code{FUN} to each vertex neighborhood's \code{STATS}. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ ~~further notes~~ } % % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{apply}}, \code{\link{sapply}} } \examples{ #Generate a random graph g<-rgraph(6) #Calculate the degree of g using gapply all(gapply(g,1,rep(1,6),sum)==degree(g,cmode="outdegree")) all(gapply(g,2,rep(1,6),sum)==degree(g,cmode="indegree")) all(gapply(g,c(1,2),rep(1,6),sum)==degree(symmetrize(g),cmode="freeman")/2) #Find first and second order neighborhood means on some variable gapply(g,c(1,2),1:6,mean) gapply(g,c(1,2),1:6,mean,distance=2) } \keyword{ iteration }% at least one, from doc/KEYWORDS \keyword{ manip }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/blockmodel.Rd0000644000176200001440000001020010501711235014174 0ustar liggesusers\name{blockmodel} \alias{blockmodel} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Generate Blockmodels Based on Partitions of Network Positions } \description{ Given a set of equivalence classes (in the form of an \code{\link{equiv.clust}} object, \code{\link{hclust}} object, or membership vector) and one or more graphs, \code{blockmodel} will form a blockmodel of the input graph(s) based on the classes in question, using the specified block content type. } \usage{ blockmodel(dat, ec, k=NULL, h=NULL, block.content="density", plabels=NULL, glabels=NULL, rlabels=NULL, mode="digraph", diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{ec}{ equivalence classes, in the form of an object of class \code{equiv.clust} or \code{hclust}, or a membership vector. } \item{k}{ the number of classes to form (using \code{\link{cutree}}). } \item{h}{ the height at which to split classes (using \code{\link{cutree}}). } \item{block.content}{ string indicating block content type (see below).} \item{plabels}{ a vector of labels to be applied to the individual nodes.} \item{glabels}{ a vector of labels to be applied to the graphs being modeled. } \item{rlabels}{ a vector of labels to be applied to the (reduced) roles. } \item{mode}{ a string indicating whether we are dealing with graphs or digraphs. } \item{diag}{ a boolean indicating whether loops are permitted. } } \details{ Unless a vector of classes is specified, \code{blockmodel} forms its eponymous models by using \code{\link{cutree}} to cut an equivalence clustering in the fashion specified by \code{k} and \code{h}. After forming clusters (roles), the input graphs are reordered and blockmodel reduction is applied. Currently supported reductions are: \enumerate{ \item \code{density}: block density, computed as the mean value of the block \item \code{meanrowsum}: mean row sums for the block \item \code{meancolsum}: mean column sums for the block \item \code{sum}: total block sum \item \code{median}: median block value \item \code{min}: minimum block value \item \code{max}: maximum block value \item \code{types}: semi-intelligent coding of blocks by ``type.'' Currently recognized types are (in order of precedence) ``\code{NA}'' (i.e., blocks with no valid data), ``null'' (i.e., all values equal to zero), ``complete'' (i.e., all values equal to 1), ``1 covered'' (i.e., all rows/cols contain a 1), ``1 row-covered'' (i.e., all rows contain a 1), ``1 col-covered'' (i.e., all cols contain a 1), and ``other'' (i.e., none of the above). } Density or median-based reductions are probably the most interpretable for most conventional analyses, though type-based reduction can be useful in examining certain equivalence class hypotheses (e.g., 1 covered and null blocks can be used to infer regular equivalence classes). Once a given reduction is performed, the model can be analyzed and/or expansion can be used to generate new graphs based on the inferred role structure. } \value{ An object of class \code{blockmodel}. } \references{ Doreian, P.; Batagelj, V.; and Ferligoj, A. (2005). \emph{Generalized Blockmodeling.} Cambridge: Cambridge University Press. White, H.C.; Boorman, S.A.; and Breiger, R.L. (1976). ``Social Structure from Multiple Networks I: Blockmodels of Roles and Positions.'' \emph{American Journal of Sociology}, 81, 730-779.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ The \code{mva} library is required for \code{blockmodel} to function. } \seealso{ \code{\link{equiv.clust}}, \code{\link{blockmodel.expand}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Cluster based on structural equivalence eq<-equiv.clust(g) #Form a blockmodel with distance relaxation of 10 b<-blockmodel(g,eq,h=10) plot(b) #Plot it } \keyword{ classif }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/dyad.census.Rd0000644000176200001440000000414310653622547014331 0ustar liggesusers\name{dyad.census} \alias{dyad.census} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute a Holland and Leinhardt MAN Dyad Census } \description{ \code{dyad.census} computes a Holland and Leinhardt dyad census on the graphs of \code{dat} selected by \code{g}. } \usage{ dyad.census(dat, g=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{g}{ the elements of \code{dat} to be included; by default, all graphs are processed. } } \details{ Each dyad in a directed graph may be in one of four states: the null state (\eqn{a \not\leftrightarrow b}{a <-!-> b}), the complete or mutual state (\eqn{a \leftrightarrow b}{a <--> b}), and either of two asymmetric states (\eqn{a \leftarrow b}{a --> b} or \eqn{a \rightarrow b}{a <-- b}). Holland and Leinhardt's dyad census classifies each dyad into the mutual, asymmetric, or null categories, counting the number of each within the digraph. These counts can be used as the basis for null hypothesis tests (since their distributions are known under assumptions such as constant edge probability), or for the generation of random graphs (e.g., via the U|MAN distribution, which conditions on the numbers of mutual, asymmetric, and null dyads in each graph). } \value{ A matrix whose three columns contain the counts of mutual, asymmetric, and null dyads (respectively) for each graph } \references{ Holland, P.W. and Leinhardt, S. (1970). ``A Method for Detecting Structure in Sociometric Data.'' \emph{American Journal of Sociology}, 76, 492-513. Wasserman, S., and Faust, K. (1994). ``Social Network Analysis: Methods and Applications.'' Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{mutuality}}, \code{\link{grecip}}, \code{\link{rguman}} \code{\link{triad.census}}, \code{\link{kcycle.census}}, \code{\link{kpath.census}} } \examples{ #Generate a dyad census of random data with varying densities dyad.census(rgraph(15,5,tprob=c(0.1,0.25,0.5,0.75,0.9))) } \keyword{ math }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/stackcount.Rd0000644000176200001440000000127111176544763014272 0ustar liggesusers\name{stackcount} \alias{stackcount} %- Also NEED an `\alias' for EACH other topic documented here. \title{ How Many Graphs are in a Graph Stack? } \description{ Returns the number of graphs in the stack provided by \code{d}. } \usage{ stackcount(d) } %- maybe also `usage' for other objects documented here. \arguments{ \item{d}{ a graph or graph stack. } } %\details{ %} \value{ The number of graphs in \code{d} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{nties}} } \examples{ stackcount(rgraph(4,8))==8 } \keyword{ utilities }%-- one or more ... \keyword{ math } sna/man/write.dl.Rd0000644000176200001440000000265210501711234013624 0ustar liggesusers\name{write.dl} \alias{write.dl} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Write Output Graphs in DL Format } \description{ Writes a graph stack to an output file in DL format. } \usage{ write.dl(x, file, vertex.lab = NULL, matrix.lab = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ a graph or graph stack, of common order. } \item{file}{ a string containing the filename to which the data should be written. } \item{vertex.lab}{ an optional vector of vertex labels. } \item{matrix.lab}{ an optional vector of matrix labels. } } \details{ DL format is used by a number of software packages (including UCINET and Pajek) to store network data. \code{write.dl} saves one or more (possibly valued) graphs in DL edgelist format, along with vertex and graph labels (if desired). These files can, in turn, be used to import data into other software packages. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{write.nos}} } \examples{ \dontrun{ #Generate a random graph stack g<-rgraph(5,10) #This would save the graphs in DL format write.dl(g,file="testfile.dl") } } \keyword{ file }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/rgnmix.Rd0000644000176200001440000000572111177262174013416 0ustar liggesusers\name{rgnmix} \Rdversion{1.1} \alias{rgnmix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Draw Mixing-Conditioned Random Graphs } \description{ \code{rgnmix} generates random draws from a mixing-conditioned uniform random graph distribution. } \usage{ rgnmix(n, tv, mix, mode = "digraph", diag = FALSE, method = c("probability", "exact"), return.as.edgelist = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{ the number of graphs to generate. } \item{tv}{ a vector of types or classes (one entry per vertex), corresponding to the rows and columns of \code{mix}. (Note that the total number of vertices generated will be \code{length(tv)}.) } \item{mix}{ a class-by-class mixing matrix, containing either mixing rates (for \code{method=="probability"}) or edge counts (for \code{method=="exact"}). } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} for undirected graphs. } \item{diag}{ logical; should loops be allowed? } \item{method}{ the generation method to use. \code{"probability"} results in a Bernoulli edge distribution (conditional on the underlying rates), while \code{"exact"} results in a uniform draw conditional on the exact per-block edge distribution. } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in sna edgelist form? } } \details{ The generated graphs (in either adjacency or edgelist form). } \value{ \code{rgnmix} draws from a simple generalization of the Erdos-Renyi N,M family (and the related N,p family), generating graphs with fixed expected or realized mixing rates. Mixing is determined by the \code{mix} argument, which must contain a class-by-class matrix of mixing rates (either edge probabilities or number of realized edges). The class for each vertex is specified in \code{tv}, whose entries must correspond to the rows and columns of \code{mix}. The resulting functionality is much like \code{\link{blockmodel.expand}}, although more general (and in some cases more efficient). } \references{ Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{rguman}}, \code{\link{rgnm}}, \code{\link{blockmodel.expand}} } \examples{ #Draw a random mixing matrix mix<-matrix(runif(9),3,3) #Generate a graph with 4 members per class g<-rgnmix(1,rep(1:3,each=4),mix) plot.sociomatrix(g) #Visualize the result #Repeat the exercise, using the exact method mix2<-round(mix*8) #Draw an exact matrix g<-rgnmix(1,rep(1:3,each=4),mix2,method="exact") plot.sociomatrix(g) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ distribution } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/maxflow.Rd0000644000176200001440000000442713573636634013601 0ustar liggesusers\name{maxflow} \Rdversion{1.1} \alias{maxflow} \alias{maxflow_EK_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Calculate Maximum Flows Between Vertices } \description{ \code{maxflow} calculates a matrix of maximum pairwise flows within a (possibly valued) input network. } \usage{ maxflow(dat, src = NULL, sink = NULL, ignore.eval = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{src}{ optionally, a vector of source vertices; by default, all vertices are selected. } \item{sink}{ optionally, a vector of sink (or target) vertices; by default, all vertices are selected. } \item{ignore.eval}{ logical; ignore edge values (i.e., assume unit capacities) when computing flow? } } \details{ \code{maxflow} computes the maximum flow from each source vertex to each sink vertex, assuming infinite vertex capacities and limited edge capacities. If \code{ignore.eval==FALSE}, supplied edge values are assumed to contain capacity information; otherwise, all non-zero edges are assumed to have unit capacity. Note that all flows computed here are pairwise -- i.e., when computing the flow from \eqn{v} to \eqn{v'}, we ignore any other flows which could also be taking place within the network. As a result, it should not be assumed that these flows can be realized \emph{simultaneously}. (For the latter purpose, the values returned by \code{maxflow} can be treated as upper bounds.) } \value{ A matrix of pairwise maximum flows (if multiple sources/sinks selected), or a single maximum flow value (otherwise). } \references{ Edmonds, J. and Karp, R.M. (1972). \dQuote{Theoretical Improvements in Algorithmic Efficiency for Network Flow Problems.} \emph{Journal of the ACM,} 19(2), 248-264. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{flowbet}}, \code{\link{geodist}} } \examples{ g<-rgraph(10,tp=2/9) #Generate a sparse random graph maxflow(g) #Compute all-pairs max flow } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/triad.census.Rd0000644000176200001440000000517113573637007014516 0ustar liggesusers\name{triad.census} \alias{triad.census} \alias{triad_census_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Davis and Leinhardt Triad Census } \description{ \code{triad.census} returns the Davis and Leinhardt triad census of the elements of \code{dat} indicated by \code{g}. } \usage{ triad.census(dat, g=NULL, mode = c("digraph", "graph")) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a graph or graph stack. } \item{g}{ the elements of \code{dat} to process. } \item{mode}{string indicating the directedness of edges; \code{"digraph"} implies a directed structure, whereas \code{"graph"} implies an undirected structure.} } \details{ The Davis and Leinhardt triad census consists of a classification of all directed triads into one of 16 different categories; the resulting distribution can be compared against various null models to test for the presence of configural biases (e.g., transitivity bias). \code{triad.census} is a front end for the \code{\link{triad.classify}} routine, performing the classification for all triads within the selected graphs. The results are placed in the order indicated by the column names; this is the same order as presented in the \code{\link{triad.classify}} documentation, to which the reader is referred for additional details. In the undirected case, the triad census reduces to four states (based on the number of edges in each triad. Where \code{mode=="graph"}, this is returned instead. Compare \code{\link{triad.census}} to \code{\link{dyad.census}}, the dyadic equivalent. } \value{ A matrix whose 16 columns contain the counts of triads by class for each graph, in the directed case. In the undirected case, only 4 columns are used. } \references{ Davis, J.A. and Leinhardt, S. (1972). ``The Structure of Positive Interpersonal Relations in Small Groups.'' In J. Berger (Ed.), \emph{Sociological Theories in Progress, Volume 2}, 218-251. Boston: Houghton Mifflin. Wasserman, S., and Faust, K. (1994). ``Social Network Analysis: Methods and Applications.'' Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } \seealso{ \code{\link{triad.classify}}, \code{\link{dyad.census}}, \code{\link{kcycle.census}}, \code{\link{kpath.census}}, \code{\link{gtrans}} } \section{Warning }{Valued data may cause strange behavior with this routine. Dichotomize the data first.} \examples{ #Generate a triad census of random data with varying densities triad.census(rgraph(15,5,tprob=c(0.1,0.25,0.5,0.75,0.9))) } \keyword{ math }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/efficiency.Rd0000644000176200001440000000703410501711235014200 0ustar liggesusers\name{efficiency} \alias{efficiency} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute Graph Efficiency Scores } \description{ \code{efficiency} takes one or more graphs (\code{dat}) and returns the Krackhardt efficiency scores for the graphs selected by \code{g}. } \usage{ efficiency(dat, g=NULL, diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{g}{ index values for the graphs to be utilized; by default, all graphs are selected. } \item{diag}{ \code{TRUE} if the diagonal contains valid data; by default, \code{diag==FALSE}. } } \details{ Let \eqn{G=\cup_{i=1}^n G_i}{G= G_1 U ... U G_n} be a digraph with weak components \eqn{G_1,G_2,\dots,G_n}{G_1,G_2,...,G_n}. For convenience, we denote the cardinalities of these components' vertex sets by \eqn{|V(G)|=N} and \eqn{|V(G_i)|=N_i}, \eqn{\forall i \in 1,\dots,n}{for i in 1,...,n}. Then the Krackhardt efficiency of \eqn{G} is given by \deqn{ 1-\frac{|E(G)| - \sum_{i=1}^n \left(N_i-1\right)}{\sum_{i=1}^n \left(N_i \left(N_i-1\right)-\left(N_i-1\right)\right)}}{% 1 - ( |E(G)| - Sum(N_i-1,i=1,..,n) )/( Sum(N_i(N_i-1) - (N_i-1),i=1,..,n) )} which can be interpreted as 1 minus the proportion of possible ``extra'' edges (above those needed to weakly connect the existing components) actually present in the graph. A graph which an efficiency of 1 has precisely as many edges as are needed to connect its components; as additional edges are added, efficiency gradually falls towards 0. Efficiency is one of four measures (\code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, and \code{\link{lubness}}) suggested by Krackhardt for summarizing hierarchical structures. Each corresponds to one of four axioms which are necessary and sufficient for the structure in question to be an outtree; thus, the measures will be equal to 1 for a given graph iff that graph is an outtree. Deviations from unity can be interpreted in terms of failure to satisfy one or more of the outtree conditions, information which may be useful in classifying its structural properties. } \value{ A vector of efficiency scores } \references{ Krackhardt, David. (1994). ``Graph Theoretical Dimensions of Informal Organizations.'' In K. M. Carley and M. J. Prietula (Eds.), \emph{Computational Organization Theory}, 89-111. Hillsdale, NJ: Lawrence Erlbaum and Associates. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The four Krackhardt indices are, in general, nondegenerate for a relatively narrow band of size/density combinations (efficiency being the sole exception). This is primarily due to their dependence on the reachability graph, which tends to become complete rapidly as size/density increase. See Krackhardt (1994) for a useful simulation study. The violation normalization used before version 0.51 was \eqn{N\left(N-1\right) \sum_{i=1}^n \left(N_i-1\right)}{N(N-1) - Sum(N_i-1,i=1,..,n)}, based on a somewhat different interpretation of the definition in Krackhardt (1994). The former version gave results which more closely matched those of the cited simulation study, but was less consistent with the textual definition.} \seealso{ \code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, \code{\link{lubness}}, \code{\link{gden}} } \examples{ #Get efficiency scores for graphs of varying densities efficiency(rgraph(10,5,tprob=c(0.1,0.25,0.5,0.75,0.9))) } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ univar }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/flowbet.Rd0000644000176200001440000001263211177262512013547 0ustar liggesusers\name{flowbet} \Rdversion{1.1} \alias{flowbet} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Calculate Flow Betweenness Scores of Network Positions } \description{ \code{flowbet} takes one or more graphs (\code{dat}) and returns the flow betweenness scores of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, flow betweenness on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ flowbet(dat, g = 1, nodes = NULL, gmode = "digraph", diag = FALSE, tmaxdev = FALSE, cmode = "rawflow", rescale = FALSE, ignore.eval = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{digraph} indicates that edges should be interpreted as directed (with flows summed over directed dyads); \code{graph} indicates that edges are undirected (with only undirected pairs considered). \code{gmode} is set to \code{digraph} by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev}==\code{FALSE}. } \item{cmode}{ one of \code{rawflow}, \code{normflow}, or \code{fracflow} (see below). } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; ignore edge values when computing maximum flow (alternately, edge values will be assumed to carry capacity information)? } } \details{ The (\dQuote{raw,} or unnormalized) flow betweenness of a vertex, \eqn{v \in V(G)}{v in V(G)}, is defined by Freeman et al. (1991) as \deqn{ C_F(v) = \sum_{i,j : i \neq j, i \neq v, j \neq v} \left(f(i,j,G) - f(i,j,G\setminus v)\right),}{% C_F(v) = sum( f(i,j,G) - f(i,j,G\v), i,j: i!=j,i!=v,j!=v ),} where \eqn{f(i,j,G)} is the maximum flow from \eqn{i} to \eqn{j} within \eqn{G} (under the assumption of infinite vertex capacities, finite edge capacities, and non-simultaneity of pairwise flows). Intuitively, unnormalized flow betweenness is simply the total maximum flow (aggregated across all pairs of third parties) mediated by \eqn{v}. The above flow betweenness measure is computed by \code{flowbet} when \code{cmode=="rawflow"}. In some cases, it may be desirable to normalize the raw flow betweenness by the total maximum flow among third parties (including \eqn{v}); this leads to the following normalized flow betweenness measure: \deqn{ C'_F(v) = \frac{\sum_{i,j : i \neq j, i \neq v, j \neq v} \left(f(i,j,G) - f(i,j,G\setminus v)\right)}{\sum_{i,j : i \neq j, i \neq v, j \neq v} f(i,j,G)}.}{% C'_F(v) = sum( f(i,j,G) - f(i,j,G\v), i,j: i!=j,i!=v,j!=v ) / sum( f(i,j,G), i,j: i!=j,i!=v,j!=v ).} This variant can be selected by setting \code{cmode=="normflow"}. Finally, it may be noted that the above normalization (from Freeman et al. (1991)) is rather different from that used in the definition of shortest-path betweenness, which normalizes within (rather than across) third-party dyads. A third flow betweenness variant has been suggested by Koschutzki et al. (2005) based on a normalization of this type: \deqn{ C''_F(v) = \sum_{i,j : i \neq j, i \neq v, j \neq v} \frac{ \left(f(i,j,G) - f(i,j,G\setminus v)\right)}{f(i,j,G)}}{% C''_F(v) = sum( (f(i,j,G) - f(i,j,G\v)) / f(i,j,G), i,j: i!=j,i!=v,j!=v ),} where 0/0 flow ratios are treated as 0 (as in shortest-path betweenness). Setting \code{cmode=="fracflow"} selects this variant. } \value{ A vector of centrality scores. } \references{ Freeman, L.C.; Borgatti, S.P.; and White, D.R. (1991). \dQuote{Centrality in Valued Graphs: A Measure of Betweenness Based on Network Flow.} \emph{Social Networks}, 13(2), 141-154. Koschutzki, D.; Lehmann, K.A.; Peeters, L.; Richter, S.; Tenfelde-Podehl, D.; Zlotowski, O. (2005). \dQuote{Centrality Indices.} In U. Brandes and T. Erlebach (eds.), \emph{Network Analysis: Methodological Foundations.} Berlin: Springer. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{betweenness}}, \code{\link{maxflow}} } \examples{ g<-rgraph(10) #Draw a random graph flowbet(g) #Raw flow betweenness flowbet(g,cmode="normflow") #Normalized flow betweenness g<-g*matrix(rpois(100,4),10,10) #Add capacity constraints flowbet(g) #Note the difference! } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ univar }% __ONLY ONE__ keyword per line sna/man/print.bayes.factor.Rd0000644000176200001440000000133111176542243015613 0ustar liggesusers\name{print.bayes.factor} \alias{print.bayes.factor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for Bayes Factor Objects } \description{ Prints a quick summary of a Bayes Factor object. } \usage{ \method{print}{bayes.factor}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{bayes.factor} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ None } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam.bf}}} %\examples{ %} \keyword{ print }%-- one or more ... sna/man/infocent.Rd0000644000176200001440000001252310501711235013700 0ustar liggesusers\name{infocent} \alias{infocent} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find Information Centrality Scores of Network Positions } \description{ \code{infocent} takes one or more graphs (\code{dat}) and returns the information centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. This function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ infocent(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, cmode="weak", tmaxdev=FALSE, rescale=FALSE,tol=1e-20) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g==1}. } \item{nodes}{ list indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. This is currently ignored. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{cmode}{ the rule to be used by \code{\link{symmetrize}} when symmetrizing dichotomous data; must be one of \code{"weak"} (for an \code{OR} rule), \code{"strong"} for an \code{AND} rule), \code{"upper"} (for a \code{max} rule), or \code{"lower"} (for a \code{min} rule). Set to \code{"weak"} by default, this parameter obviously has no effect on symmetric data. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{tol}{ tolerance for near-singularities during matrix inversion (see \code{\link{solve}}). } } \details{ Actor information centrality is a hybrid measure which relates to both path-length indices (e.g., closeness, graph centrality) and to walk-based eigenmeasures (e.g., eigenvector centrality, Bonacich power). In particular, the information centrality of a given actor can be understood to be the harmonic average of the ``bandwidth'' for all paths originating with said individual (where the bandwidth is taken to be inversely related to path length). Formally, the index is constructed as follows. First, we take \eqn{G} to be an undirected (but possibly valued) graph -- symmetrizing if necessary -- with (possibly valued) adjacency matrix \eqn{\mathbf{A}}{A}. From this, we remove all isolates (whose information centralities are zero in any event) and proceed to create the weighted connection matrix \deqn{ \mathbf{C} = \mathbf{B}^{-1}}{% C = B^-1} where \eqn{\mathbf{B}}{B} is a pseudo-adjacency matrix formed by replacing the diagonal of \eqn{1-\mathbf{A}}{1-A} with one plus each actor's degree. Given the above, let \eqn{T} be the trace of \eqn{\mathbf{C}}{C} with sum \eqn{S_T}, and let \eqn{S_R} be an arbitrary row sum (all rows of \eqn{\mathbf{C}}{C} have the same sum). The information centrality scores are then equal to \deqn{ C_I = \frac{1}{T + \frac{S_T-2S_R}{|V(G)|}}}{% C_I = ( T + (S_T-2S_R)/|V(G)| )^-1 } (recalling that the scores for any omitted vertices are 0). In general, actors with higher information centrality are predicted to have greater control over the flow of information within a network; highly information-central individuals tend to have a large number of short paths to many others within the social structure. Because the raw centrality values can be difficult to interpret directly, rescaled values are sometimes preferred (see the \code{rescale} option). Though the use of path weights suggest information centrality as a possible replacement for closeness, the problem of inverting the \eqn{\mathbf{B}}{B} matrix poses problems of its own; as with all such measures, caution is advised on disconnected or degenerate structures. } \value{ A vector, matrix, or list containing the centrality scores (depending on the number and size of the input graphs). } \references{ Stephenson, K., and Zelen, M. (1989). ``Rethinking Centrality: Methods and Applications.'' \emph{Social Networks}, 11, 1-37. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ David Barron \email{david.barron@jesus.ox.ac.uk} Carter T. Butts \email{buttsc@uci.edu} } \note{ The theoretical maximum deviation used here is not obtained with the star network; rather, the maximum occurs for an empty graph with one complete dyad, which is the model used here. } \seealso{ \code{\link{evcent}}, \code{\link{bonpow}}, \code{\link{closeness}}, \code{\link{graphcent}}, \code{\link{centralization}} } \examples{ #Generate some test data dat<-rgraph(10,mode="graph") #Compute information centrality scores infocent(dat) } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ univar }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/sdmat.Rd0000644000176200001440000001451511361526203013212 0ustar liggesusers\name{sdmat} \alias{sdmat} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Estimate the Structural Distance Matrix for a Graph Stack} \description{ Estimates the structural distances among all elements of \code{dat} using the method specified in \code{method}. } \usage{ sdmat(dat, normalize=FALSE, diag=FALSE, mode="digraph", output="matrix", method="mc", exchange.list=NULL, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ graph set to be analyzed. } \item{normalize}{ divide by the number of available dyads? } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default. } \item{output}{ \code{"matrix"} for matrix output, \code{"dist"} for a \code{\link{dist}} object. } \item{method}{ method to be used to search the space of accessible permutations; must be one of \code{"none"}, \code{"exhaustive"}, \code{"anneal"}, \code{"hillclimb"}, or \code{"mc"}. } \item{exchange.list}{ information on which vertices are exchangeable (see below); this must be a single number, a vector of length n, or a nx2 matrix. } \item{\dots}{ additional arguments to \code{\link{lab.optimize}}.} } \details{ The structural distance between two graphs G and H is defined as \deqn{d_S\left(G,H \left| L_G,L_H\right.\right) = \min_{L_G,L_H} d\left(\ell\left(G\right),\ell\left(H\right)\right)}{% d_S(G,H | L_G,L_H) = min_[L_G,L_H] d(l(G),l(H))} where \eqn{L_G} is the set of accessible permutations/labelings of G, and \eqn{\ell(G)}{l(G)} is a permuation/relabeling of the vertices of G (\eqn{\ell(G) \in L_G}{l(G) in L_G}). The set of accessible permutations on a given graph is determined by the \emph{theoretical exchangeability} of its vertices; in a nutshell, two vertices are considered to be theoretically exchangeable for a given problem if all predictions under the conditioning theory are invariant to a relabeling of the vertices in question (see Butts and Carley (2001) for a more formal exposition). Where no vertices are exchangeable, the structural distance becomes the its labeled counterpart (here, the Hamming distance). Where \emph{all} vertices are exchangeable, the structural distance reflects the distance between unlabeled graphs; other cases correspond to distance under partial labeling. The accessible permutation set is determined by the \code{exchange.list} argument, which is dealt with in the following manner. First, \code{exchange.list} is expanded to fill an nx2 matrix. If \code{exchange.list} is a single number, this is trivially accomplished by replication; if \code{exchange.list} is a vector of length n, the matrix is formed by cbinding two copies together. If \code{exchange.list} is already an nx2 matrix, it is left as-is. Once the nx2 exchangeabiliy matrix has been formed, it is interpreted as follows: columns refer to graphs 1 and 2, respectively; rows refer to their corresponding vertices in the original adjacency matrices; and vertices are taken to be theoretically exchangeable iff their corresponding exchangeability matrix values are identical. To obtain an unlabeled distance (the default), then, one could simply let \code{exchange.list} equal any single number. To obtain the Hamming distance, one would use the vector \code{1:n}. Because the set of accessible permutations is, in general, very large (\eqn{o(n!)}), searching the set for the minimum distance is a non-trivial affair. Currently supported methods for estimating the structural distance are hill climbing, simulated annealing, blind monte carlo search, or exhaustive search (it is also possible to turn off searching entirely). Exhaustive search is not recommended for graphs larger than size 8 or so, and even this may take days; still, this is a valid alternative for small graphs. Blind monte carlo search and hill climbing tend to be suboptimal for this problem and are not, in general recommended, but they are available if desired. The preferred (and default) option for permutation search is simulated annealing, which seems to work well on this problem (though some tinkering with the annealing parameters may be needed in order to get optimal performance). See the help for \code{\link{lab.optimize}} for more information regarding these options. Structural distance matrices may be used in the same manner as any other distance matrices (e.g., with multidimensional scaling, cluster analysis, etc.) Classical null hypothesis tests should not be employed with structural distances, and QAP tests are almost never appropriate (save in the uniquely labeled case). See \code{\link{cugtest}} for a more reasonable alternative. } \value{ A matrix of distances (or an object of class \code{dist}) } \references{ Butts, C.T. and Carley, K.M. (2005). \dQuote{Some Simple Algorithms for Structural Comparison.} \emph{Computational and Mathematical Organization Theory,} 11(4), 291-305. Butts, C.T., and Carley, K.M. (2001). \dQuote{Multivariate Methods for Interstructural Analysis.} CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ For most applications, \code{sdmat} is dominated by \code{\link{structdist}}; the former is retained largely for reasons of compatibility.} \section{Warning }{The search process can be \emph{very slow}, particularly for large graphs. In particular, the \emph{exhaustive} method is order factorial, and will take approximately forever for unlabeled graphs of size greater than about 7-9.} \seealso{ \code{\link{hdist}}, \code{\link{structdist}} } \examples{ #Generate two random graphs g<-array(dim=c(3,5,5)) g[1,,]<-rgraph(5) g[2,,]<-rgraph(5) #Copy one of the graphs and permute it g[3,,]<-rmperm(g[2,,]) #What are the structural distances between the labeled graphs? sdmat(g,exchange.list=1:5) #What are the structural distances between the underlying unlabeled #graphs? sdmat(g,method="anneal", prob.init=0.9, prob.decay=0.85, freeze.time=50, full.neighborhood=TRUE) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/print.blockmodel.Rd0000644000176200001440000000133411176542214015347 0ustar liggesusers\name{print.blockmodel} \alias{print.blockmodel} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for blockmodel Objects } \description{ Prints a quick summary of a \code{\link{blockmodel}} object. } \usage{ \method{print}{blockmodel}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{blockmodel} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ None } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{blockmodel}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/gliop.Rd0000644000176200001440000000336710501711235013213 0ustar liggesusers\name{gliop} \alias{gliop} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Return a Binary Operation on GLI Values Computed on Two Graphs } \description{ \code{gliop} is a wrapper which allows for an arbitrary binary operation on GLIs to be treated as a single call. This is particularly useful for test routines such as \code{\link{cugtest}} and \code{\link{qaptest}}. } \usage{ gliop(dat, GFUN, OP="-", g1=1, g2=2, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a collection of graphs. } \item{GFUN}{ a function taking single graphs as input. } \item{OP}{ the operator to use on the output of \code{GFUN}. } \item{g1}{ the index of the first input graph. } \item{g2}{ the index of the second input graph. } \item{\dots}{ Additional arguments to \code{GFUN} } } \details{ \code{gliop} operates by evaluating \code{GFUN} on the graphs indexed by \code{g1} and \code{g2} and returning the result of \code{OP} as applied to the \code{GFUN} output. } \value{ \code{OP(GFUN(dat[g1, , ],...),GFUN(dat[g2, , ],...))} } \references{ Anderson, B.S.; Butts, C.T.; and Carley, K.M. (1999). ``The Interaction of Size and Density with Graph-Level Indices.'' \emph{Social Networks}, 21(3), 239-267. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ If the output of \code{GFUN} is not sufficiently well-behaved, undefined behavior may occur. Common sense is advised. } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{cugtest}}, \code{\link{qaptest}} } \examples{ #Draw two random graphs g<-rgraph(10,2,tprob=c(0.2,0.5)) #What is their difference in density? gliop(g,gden,"-",1,2) } \keyword{ utilities }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/gtrans.Rd0000644000176200001440000001112313573636756013416 0ustar liggesusers\name{gtrans} \alias{gtrans} \alias{transitivity_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Transitivity of an Input Graph or Graph Stack } \description{ \code{gtrans} returns the transitivity of the elements of \code{dat} selected by \code{g}, using the definition of \code{measure}. Triads involving missing values are omitted from the analysis. } \usage{ gtrans(dat, g=NULL, diag=FALSE, mode="digraph", measure = c("weak", "strong", "weakcensus", "strongcensus", "rank", "correlation"), use.adjacency = TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a collection of input graphs. } \item{g}{ a vector indicating the graphs which are to be analyzed; by default, all graphs are analyzed. } \item{diag}{ a boolean indicating whether or not diagonal entries (loops) are to be taken as valid data. } \item{mode}{ \code{"digraph"} if directed triads are sought, or else \code{"graph"}. } \item{measure}{ one of \code{"weak"} (default), \code{"strong"}, \code{"weakcensus"}, \code{"strongcensus"}, \code{"rank"}, or \code{"correlation"}. } \item{use.adjacency}{ logical; should adjacency matrices (versus sparse graph methods) be used in the transitivity computation?} } \details{ Transitivity is a triadic, algebraic structural constraint. In its weak form, the transitive constraint corresponds to \eqn{a \rightarrow b \rightarrow c \Rightarrow a \rightarrow c}{a->b->c => a->c}. In the corresponding strong form, the constraint is \eqn{a \rightarrow b \rightarrow c \Leftrightarrow a \rightarrow c}{a->b->c <=> a->c}. (Note that the weak form is that most commonly employed.) Where \code{measure=="weak"}, the fraction of potentially intransitive triads obeying the weak condition is returned. With the \code{measure=="weakcensus"} setting, by contrast, the total \emph{number} of transitive triads is computed. The \code{strong} versions of the measures are similar to the above, save in that the set of all triads is considered (since all are ``at risk'' for intransitivity). Note that where missing values prevent the assessment of whether a triple is transitive, that triple is omitted. Generalizations of transitivity to valued graphs are numerous. The above strong and weak forms ignore edge values, treating any non-zero edge as present. Two additional notions of transitivity are also supported valued data. The \code{"rank"} condition treads an \eqn{(i, j, k)} triple as transitive if the value of the \eqn{(i,k)} directed dyad is greater than or equal to the minimum of the values of the \eqn{(i,j)} and \eqn{(j,k)} dyads. The \code{"correlation"} option implements the correlation transitivity of David Dekker, which is defined as the matrix correlation of the valued adjacency matrix \eqn{A} with its second power (i.e., \eqn{A^2}), omitting diagonal entries where inapplicable. Note that the base forms of transitivity can be calculated using either matrix multiplication or sparse graph methods. For very large, sparse graphs, the sparse graph method (which can be forced by \code{use.adjacency=FALSE}) may be preferred. The latter provides much better scaling, but is significantly slower for networks of typical size due to the overhead involved (and R's highly optimized matrix operations). Where \code{use.adjacency} is set to \code{TRUE}, \code{gtrans} will attempt some simple heuristics to determine if the edgelist method should be used instead (and will do so if indicated). These heuristics depend on recognition of the input data type, and hence may behave slightly differently depending on the form in which \code{dat} is given. Note that the rank measure can at present be calculated only via sparse graph methods, and the correlation measure only by adjacency matrices. For these measures, the \code{use.adjacency} argument is ignored. } \value{ A vector of transitivity scores } \references{ Holland, P.W., and Leinhardt, S. (1972). ``Some Evidence on the Transitivity of Positive Interpersonal Sentiment.'' \emph{American Journal of Sociology,} 72, 1205-1209. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ In version 0.3, the strong form was the default (and only) option for \code{gtrans}. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{triad.classify}}, \code{\link{cugtest}} } \examples{ #Draw some random graphs g<-rgraph(5,10) #Find transitivity scores gtrans(g) } \keyword{ algebra }%-- one or more ... \keyword{ graphs } sna/man/gplot.arrow.Rd0000644000176200001440000000536310501711235014355 0ustar liggesusers\name{gplot.arrow} \alias{gplot.arrow} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Add Arrows or Segments to a Plot } \description{ \code{gplot.arrow} draws a segment or arrow between two pairs of points; unlike \code{\link{arrows}} or \code{\link{segments}}, the new plot element is drawn as a polygon. } \usage{ gplot.arrow(x0, y0, x1, y1, length = 0.1, angle = 20, width = 0.01, col = 1, border = 1, lty = 1, offset.head = 0, offset.tail = 0, arrowhead = TRUE, curve = 0, edge.steps = 50, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x0}{ A vector of x coordinates for points of origin } \item{y0}{ A vector of y coordinates for points of origin } \item{x1}{ A vector of x coordinates for destination points } \item{y1}{ A vector of y coordinates for destination points } \item{length}{ Arrowhead length, in current plotting units } \item{angle}{ Arrowhead angle (in degrees) } \item{width}{ Width for arrow body, in current plotting units (can be a vector) } \item{col}{ Arrow body color (can be a vector) } \item{border}{ Arrow border color (can be a vector) } \item{lty}{ Arrow border line type (can be a vector) } \item{offset.head}{ Offset for destination point (can be a vector) } \item{offset.tail}{ Offset for origin point (can be a vector) } \item{arrowhead}{ Boolean; should arrowheads be used? (Can be a vector)) } \item{curve}{ Degree of edge curvature (if any), in current plotting units (can be a vector) } \item{edge.steps}{ For curved edges, the number of steps to use in approximating the curve (can be a vector)} \item{\dots}{ Additional arguments to \code{\link{polygon}} } } \details{ \code{gplot.arrow} provides a useful extension of \code{\link{segments}} and \code{\link{arrows}} when fine control is needed over the resulting display. (The results also look better.) Note that edge curvature is quadratic, with \code{curve} providing the maximum horizontal deviation of the edge (left-handed). Head/tail offsets are used to adjust the end/start points of an edge, relative to the baseline coordinates; these are useful for functions like \code{\link{gplot}}, which need to draw edges incident to vertices of varying radii. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot}}, \code{\link{gplot.loop}}, \code{\link{polygon}} } \examples{ #Plot two points plot(1:2,1:2) #Add an edge gplot.arrow(1,1,2,2,width=0.01,col="red",border="black") } \keyword{ aplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/isolates.Rd0000644000176200001440000000234710501711235013721 0ustar liggesusers\name{isolates} \alias{isolates} %- Also NEED an `\alias' for EACH other topic documented here. \title{ List the Isolates in a Graph or Graph Stack } \description{ Returns a list of the isolates in the graph or graph set given by \code{dat}. } \usage{ isolates(dat, diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{diag}{ boolean indicating whether adjacency matrix diagonals (i.e., loops) contain meaningful data. } } %\details{ %} \value{ A vector containing the isolates, or a list of vectors if more than one graph was specified } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. West, D.B. (1996). \emph{Introduction to Graph Theory}. Upper Saddle River, NJ: Prentice Hall.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{is.isolate}}, \code{\link{add.isolates}} } \examples{ #Generate a test graph g<-rgraph(20) g[,4]<-0 #Create an isolate g[4,]<-0 #List the isolates isolates(g) } \keyword{ math }%-- one or more ... \keyword{ graphs } sna/man/plot.lnam.Rd0000644000176200001440000000157711176527340014021 0ustar liggesusers\name{plot.lnam} \alias{plot.lnam} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Plotting for lnam Objects } \description{ Generates various diagnostic plots for \code{\link{lnam} objects.} } \usage{ \method{plot}{lnam}(x, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ an object of class \code{lnam}. } \item{\dots}{ additional arguments to \code{\link{plot}}. } } %\details{ % ~~ If necessary, more details than the __description__ above ~~ %} \value{ None } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{lnam}} } %\examples{ %} \keyword{ hplot }% at least one, from doc/KEYWORDS %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line sna/man/summary.netlogit.Rd0000644000176200001440000000140411176706302015420 0ustar liggesusers\name{summary.netlogit} \alias{summary.netlogit} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of netlogit Objects } \description{ Returns a \code{netlogit} summary object~ } \usage{ \method{summary}{netlogit}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{netlogit} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ An object of class \code{summary.netlogit} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{\code{\link{netlogit}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/neighborhood.Rd0000644000176200001440000000644710541665146014567 0ustar liggesusers\name{neighborhood} \alias{neighborhood} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute Neighborhood Structures of Specified Order } \description{ For a given graph, returns the specified neighborhood structure at the selected order(s). } \usage{ neighborhood(dat, order, neighborhood.type = c("in", "out", "total"), mode = "digraph", diag = FALSE, thresh = 0, return.all = FALSE, partial = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{order}{ order of the neighborhood to extract. } \item{neighborhood.type}{ neighborhood type to employ. } \item{mode}{ \code{"digraph"} if \code{dat} is directed, otherwise \code{"graph"}. } \item{diag}{ logical; do the diagonal entries of \code{dat} contain valid data? } \item{thresh}{ dichotomization threshold to use for \code{dat}; edges whose values are greater than \code{thresh} are treated as present. } \item{return.all}{ logical; return neighborhoods for all orders up to \code{order}? } \item{partial}{ logical; return partial (rather than cumulative) neighborhoods? } } \details{ The adjacency matrix associated with the \eqn{i}th order neighborhood is defined as the identity matrix for order 0, and otherwise depends on the type of neighborhood involved. For input graph \eqn{G=(V,E)}, let the \emph{base relation}, \eqn{R}, be given by the underlying graph of \eqn{G} (i.e., \eqn{G \cup G^T}{G U G^T}) if total neighborhoods are sought, the transpose of \eqn{G} if incoming neighborhoods are sought, or \eqn{G} otherwise. The partial neighborhood structure of order \eqn{i>0} on \eqn{R} is then defined to be the digraph on \eqn{V} whose edge set consists of the ordered pairs \eqn{(j,k)} having geodesic distance \eqn{i} in \eqn{R}. The corresponding cumulative neighborhood is formed by the ordered pairs having geodesic distance less than or equal to \eqn{i} in \eqn{R}. Neighborhood structures are commonly used to parameterize various types of network autocorrelation models. They may also be used in the calculation of certain types of local structural indices; \code{\link{gapply}} provides an alternative function which can be used for this purpose. } \value{ An array or adjacency matrix containing the neighborhood structures (if \code{dat} is a single graph); if \code{dat} contains multiple graphs, then a list of such structures is returned. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ % % ~Make other sections like Warning with \section{Warning }{....} ~ %} \seealso{ \code{\link{gapply}}, \code{\link{nacf}}} \examples{ #Draw a random graph g<-rgraph(10,tp=2/9) #Show the total partial out-neighborhoods neigh<-neighborhood(g,9,neighborhood.type="out",return.all=TRUE) par(mfrow=c(3,3)) for(i in 1:9) gplot(neigh[i,,],main=paste("Partial Neighborhood of Order",i)) #Show the total cumulative out-neighborhoods neigh<-neighborhood(g,9,neighborhood.type="out",return.all=TRUE, partial=FALSE) par(mfrow=c(3,3)) for(i in 1:9) gplot(neigh[i,,],main=paste("Cumulative Neighborhood of Order",i)) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ manip }% __ONLY ONE__ keyword per line sna/man/nties.Rd0000644000176200001440000000246210501711234013215 0ustar liggesusers\name{nties} \alias{nties} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Number of Possible Ties in a Given Graph or Graph Stack } \description{ \code{nties} returns the number of possible edges in each element of \code{dat}, given \code{mode} and \code{diag}. } \usage{ nties(dat, mode="digraph", diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a graph or set thereof. } \item{mode}{ one of ``digraph'', ``graph'', and ``hgraph''. } \item{diag}{ a boolean indicating whether or not diagonal entries (loops) should be treated as valid data; ignored for hypergraphic (``hgraph'') data. } } \details{ \code{nties} is used primarily to automate maximum edge counts for use with normalization routines. } \value{ The number of possible edges, or a vector of the same } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ For two-mode (hypergraphic) data, the value returned isn't technically the number of edges per se, but rather the number of edge memberships. } %~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #How many possible edges in a loopless digraph of order 15? nties(rgraph(15),diag=FALSE) } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/evcent.Rd0000644000176200001440000001205613573636116013400 0ustar liggesusers\name{evcent} \alias{evcent} \alias{evcent_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find Eigenvector Centrality Scores of Network Positions } \description{ \code{evcent} takes one or more graphs (\code{dat}) and returns the eigenvector centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. This function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ evcent(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, rescale=FALSE, ignore.eval=FALSE, tol=1e-10, maxiter=1e5, use.eigen=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. This is currently ignored. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; should edge values be ignored?} \item{tol}{ convergence tolerance for the eigenvector computation.} \item{maxiter}{ maximum iterations for eigenvector calculation.} \item{use.eigen}{ logical; should we use R's \code{\link{eigen}} routine instead of the (faster but less robust) internal method?} } \details{ Eigenvector centrality scores correspond to the values of the first eigenvector of the graph adjacency matrix; these scores may, in turn, be interpreted as arising from a reciprocal process in which the centrality of each actor is proportional to the sum of the centralities of those actors to whom he or she is connected. In general, vertices with high eigenvector centralities are those which are connected to many other vertices which are, in turn, connected to many others (and so on). (The perceptive may realize that this implies that the largest values will be obtained by individuals in large cliques (or high-density substructures). This is also intelligible from an algebraic point of view, with the first eigenvector being closely related to the best rank-1 approximation of the adjacency matrix (a relationship which is easy to see in the special case of a diagonalizable symmetric real matrix via the \eqn{S \Lambda S^{-1}}{SLS^-1} decomposition).) By default, a sparse-graph power method is used to obtain the principal eigenvector. This procedure scales well, but may not converge in some cases. In the event that the convergence objective set by \code{tol} is not obtained, \code{evcent} will return a warning message. Correctives in this case include increasing \code{maxiter}, or setting \code{use.eigen} to \code{TRUE}. The latter will cause \code{evcent} to use R's standard \code{\link{eigen}} method to calculate the principal eigenvector; this is far slower for sparse graphs, but is also more robust. The simple eigenvector centrality is generalized by the Bonacich power centrality measure; see \code{\link{bonpow}} for more details. } \value{ A vector, matrix, or list containing the centrality scores (depending on the number and size of the input graphs). } \references{ Bonacich, P. (1987). ``Power and Centrality: A Family of Measures.'' \emph{American Journal of Sociology}, 92, 1170-1182. Katz, L. (1953). ``A New Status Index Derived from Sociometric Analysis.'' \emph{Psychometrika}, 18, 39-43. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The theoretical maximum deviation used here is not obtained with the star network, in general. For symmetric data, the maximum occurs for an empty graph with one complete dyad; the maximum deviation for asymmetric data is generated by the outstar. UCINET V seems not to adjust for this fact, which can cause some oddities in their centralization scores (and results in a discrepancy in centralizations between the two packages). } \section{WARNING }{\code{evcent} will not symmetrize your data before extracting eigenvectors; don't send this routine asymmetric matrices unless you really mean to do so.} \seealso{ \code{\link{centralization}}, \code{\link{bonpow}} } \examples{ #Generate some test data dat<-rgraph(10,mode="graph") #Compute eigenvector centrality scores evcent(dat) } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/sna.operators.Rd0000644000176200001440000000250712743337406014710 0ustar liggesusers\name{sna.operators} \alias{sna.operators} \alias{\%c\%.matrix} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Graphical Operators } \description{ These operators allow for algebraic manupulation of graph adjacency matrices. } \usage{ \method{\%c\%}{matrix}(e1,e2) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{e1}{ an (unvalued) adjacency matrix. } \item{e2}{ another (unvalued) adjacency matrix. } } \details{ Currently, only one operator is supported. \code{x \%c\% y} returns the adjacency matrix of the composition of graphs with adjacency matrices \code{x} and \code{y} (respectively). (Note that this may contain loops.) } \value{ The resulting adjacency matrix. } \references{ Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: University of Cambridge Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ %\seealso{ ~~objects to See Also as \code{\link{~~fun~~}}, ~~~ } \examples{ #Create an in-star g<-matrix(0,6,6) g[2:6,1]<-1 gplot(g) #Compose g with its transpose gcgt<-g\%c\%t(g) gplot(gcgt,diag=TRUE) gcgt } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/sna-internal.Rd0000644000176200001440000000124713573640004014476 0ustar liggesusers\name{sna-internal} \alias{sna-internal} \alias{bbnam.jntlik} \alias{bbnam.jntlik.slice} \alias{bbnam.probtie} \alias{logSum} \alias{logMean} \alias{logSub} \alias{aggarray3d_R} \alias{dyadcode_R} \alias{logadd_R} \alias{logsub_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Internal sna Functions } \description{ Internal \code{sna} functions. } \usage{ bbnam.jntlik(dat, log=FALSE, ...) bbnam.jntlik.slice(s, dat, a, em, ep, log=FALSE) bbnam.probtie(dat, i, j, npriorij, em, ep) logMean(x) logSub(x, y) logSum(x) } %- maybe also `usage' for other objects documented here. \details{ These are not to be called by the end user. } \keyword{internal} sna/man/degree.Rd0000644000176200001440000001013213573636046013342 0ustar liggesusers\name{degree} \alias{degree} \alias{degree_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Degree Centrality Scores of Network Positions } \description{ \code{Degree} takes one or more graphs (\code{dat}) and returns the degree centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, indegree, outdegree, or total (Freeman) degree will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ degree(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, cmode="freeman", rescale=FALSE, ignore.eval=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{gmode} is set to \code{"digraph"} by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{cmode}{ string indicating the type of degree centrality being computed. \code{"indegree"}, \code{"outdegree"}, and \code{"freeman"} refer to the indegree, outdegree, and total (Freeman) degree measures, respectively. The default for \code{cmode} is \code{"freeman"}. } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; should edge values be ignored when computing degree scores?} } \details{ Degree centrality is the social networker's term for various permutations of the graph theoretic notion of vertex degree: for unvalued graphs, indegree of a vertex, \eqn{v}, corresponds to the cardinality of the vertex set \eqn{N^+(v)=\{i \in V(G) : (i,v) \in E(G)\}}{N^+(v) = \{i in V(G) : (i,v) in E(G)\}}; outdegree corresponds to the cardinality of the vertex set \eqn{N^-(v)=\{i \in V(G) : (v,i) \in E(G)\}}{N^-(v) = \{i in V(G) : (v,i) in E(G)\}}; and total (or \dQuote{Freeman}) degree corresponds to \eqn{\left|N^+(v)\right| + \left|N^-(v)\right|}{|N^+(v)|+|N^-(v)|}. (Note that, for simple graphs, indegree=outdegree=total degree/2.) Obviously, degree centrality can be interpreted in terms of the sizes of actors' neighborhoods within the larger structure. See the references below for more details. When \code{ignore.eval==FALSE}, \code{degree} weights edges by their values where supplied. \code{ignore.eval==TRUE} ensures an unweighted degree score (independent of input). Setting \code{gmode=="graph"} forces behavior equivalent to \code{cmode=="indegree"} (i.e., each edge is counted only once); to obtain a total degree score for an undirected graph in which both in- and out-neighborhoods are counted separately, simply use \code{gmode=="digraph"}. } \value{ A vector, matrix, or list containing the degree scores (depending on the number and size of the input graphs). } \references{ Freeman, L.C. (1979). ``Centrality in Social Networks I: Conceptual Clarification.'' \emph{Social Networks}, 1, 215-239. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{centralization}} } \examples{ #Create a random directed graph dat<-rgraph(10) #Find the indegrees, outdegrees, and total degrees degree(dat,cmode="indegree") degree(dat,cmode="outdegree") degree(dat) } \keyword{univar} \keyword{ math } sna/man/print.summary.netcancor.Rd0000644000176200001440000000137511176541743016717 0ustar liggesusers\name{print.summary.netcancor} \alias{print.summary.netcancor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.netcancor Objects } \description{ Prints an object of class \code{summary.netcancor}. } \usage{ \method{print}{summary.netcancor}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.netcancor}} \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.netcancor}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/path.census.Rd0000644000176200001440000002041113573636012014334 0ustar liggesusers\name{kpath.census} \alias{kpath.census} \alias{kcycle.census} \alias{cycleCensus_R} \alias{pathCensus_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute Path or Cycle Census Information } \description{ \code{kpath.census} and \code{kcycle.census} compute \eqn{k}-path or \eqn{k}-cycle census statistics (respectively) on one or more input graphs. In addition to aggregate counts of paths or cycles, results may be disaggregated by vertex and co-membership information may be computed. } \usage{ kcycle.census(dat, maxlen = 3, mode = "digraph", tabulate.by.vertex = TRUE, cycle.comembership = c("none", "sum", "bylength")) kpath.census(dat, maxlen = 3, mode = "digraph", tabulate.by.vertex = TRUE, path.comembership = c("none", "sum", "bylength"), dyadic.tabulation = c("none", "sum", "bylength")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{cycle.comembership}{ the type of cycle co-membership information to be tabulated, if any. \code{"sum"} returns a vertex by vertex matrix of cycle co-membership counts; these are disaggregated by cycle length if \code{"bylength"} is used. If \code{"none"} is given, no co-membership information is computed.} \item{dat}{ one or more input graphs. } \item{maxlen}{ the maximum path/cycle length to evaluate. } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} for undirected graphs.} \item{tabulate.by.vertex}{ logical; should path or cycle incidence counts be tabulated by vertex? } \item{path.comembership}{ as per \code{cycle.comembership}, for paths rather than cycles. } \item{dyadic.tabulation}{ the type of dyadic path count information to be tabulated, if any. \code{"sum"} returns a vertex by vertex matrix of source/destination path counts, while \code{"bylength"} disaggregates these counts by path length. Selecting \code{"none"} disables this computation. } } \details{ There are several equivalent characterizations of paths and cycles, of which the following is one example. For an arbitrary graph \eqn{G}, a \emph{path} is a sequence of distinct vertices \eqn{v_1, v_2, \ldots, v_n}{v_1, v_2, .... v_n} and included edges such that \eqn{v_i} is adjacent to \eqn{v_{i+1}} for all \eqn{i \in 1, 2, \ldots, n-1}{i in 1, 2, ... k-1} via the pair's included edge. (Contrast this with a \emph{walk}, in which edges and/or vertices may be repeated.) A \emph{cycle} is the union of a path and an edge making \eqn{v_n} adjacent to \eqn{v_i}. \eqn{k}-paths and \eqn{k}-cycles are respective paths and cycles having \eqn{k} edges (in the former case) or \eqn{k} vertices (in the latter). The above definitions may be applied in both directed and undirected contexts, by substituting the appropriate notion of adjacency. (Note that authors do not always employ the same terminology for these concepts, especially in older texts -- it is wise to verify the definitions being used in any particular context.) A \emph{subgraph census statistic} is a function which, for any given graph and subgraph, gives the number of copies of the latter contained in the former. A collection of subgraph census statistics is referred to as a \emph{subgraph census}; widely used examples include the dyad and triad censuses, implemented in \code{sna} by the \code{\link{dyad.census}} and \code{\link{triad.census}} functions (respectively). \code{kpath.census} and \code{kcycle.census} compute a range of census statistics related to \eqn{k}-paths and \eqn{k}-cycles, including: \itemize{ \item Aggregate counts of paths/cycles by length (i.e., \eqn{k}). \item Counts of paths/cycles to which each vertex belongs (when \code{tabulate.byvertex==TRUE}). \item Counts of path/cycle co-memberships, potentially disaggregated by length (when the appropriate co-membership argument is set to \code{bylength}). \item For \code{path.census}, counts of the total number of paths from each vertex to each other vertex, possibly disaggregated by length (if \code{dyadic.tabulation=="bylength"}). } The length of the maximum-length path/cycle to compute is given by \code{maxlen}. These calculations are intrinsically expensive (path/cycle computation is NP complete in the general case), and users should hence be wary when increasing \code{maxlen}. On the other hand, it may be possible to enumerate even long paths or cycles on a very sparse graph; scaling is approximately \eqn{c^k}, where \eqn{k} is given by \code{maxlen} and \eqn{c} is the size of the largest dense cluster. The paths or cycles computed by this function are directed if \code{mode=="digraph"}, or undirected if \code{mode=="graph"}. Failing to set \code{mode} correctly may result in problematic behavior. } \value{ For \code{kpath.census}, a list with the following elements: \item{path.count }{If \code{tabulate.byvertex==FALSE}, a vector of aggregate counts by path length. Otherwise, a matrix whose first column is a vector of aggregate path counts, and whose succeeding columns contain vectors of path counts for each vertex.} \item{path.comemb }{If \code{path.comembership!="none"}, a matrix or array containing co-membership in paths by vertex pairs. If \code{path.comembership=="sum"}, only a matrix of co-memberships is returned; if \code{bylength} is used, however, co-memberships are returned in a \code{maxlen} by \eqn{n} by \eqn{n} array whose \eqn{i,j,k}th cell is the number of paths of length \eqn{i} containing \code{j} and \code{k}.} \item{paths.bydyad }{If \code{dyadic.tabulation!="none"}, a matrix or array containing the number of paths originating at a particular vertex and terminating. If \code{bylength} is used, dyadic path counts are supplied via a \code{maxlen} by \eqn{n} by \eqn{n} array whose \eqn{i,j,k}th cell is the number of paths of length \eqn{i} starting at \code{j} and ending with \code{k}. If \code{sum} is used instead, only a matrix whose \eqn{i,j} cell contains the total number of paths from \eqn{i} to \eqn{j} is returned.} For \code{kcycle.census}, a similar list: \item{cycle.count }{If \code{tabulate.byvertex==FALSE}, a vector of aggregate counts by cycle length. Otherwise, a matrix whose first column is a vector of aggregate cycle counts, and whose succeeding columns contain vectors of cycle counts for each vertex.} \item{cycle.comemb }{If \code{cycle.comembership!="none"}, a matrix or array containing co-membership in cycles by vertex pairs. If \code{cycle.comembership=="sum"}, only a matrix of co-memberships is returned; if \code{bylength} is used, however, co-memberships are returned in a \code{maxlen} by \eqn{n} by \eqn{n} array whose \eqn{i,j,k}th cell is the number of cycles of length \eqn{i} containing \code{j} and \code{k}.} } \references{ Butts, C.T. (2006). \dQuote{Cycle Census Statistics for Exponential Random Graph Models.} IMBS Technical Report MBS 06-05, University of California, Irvine. West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ % \section{Warning }{ The computational cost of calculating paths and cycles grows very sharply in both \code{maxlen} and network density. Be wary of setting \code{maxlen} greater than 5-6, unless you know what you are doing. Otherwise, the expected completion time for your calculation may exceed your life expectancy (and those of subsequent generations). } %} \seealso{ \code{\link{dyad.census}}, \code{\link{triad.census}}, \code{\link{clique.census}}, \code{\link{geodist}} } \examples{ g<-rgraph(20,tp=1.5/19) #Obtain paths by vertex, with dyadic path counts pc<-kpath.census(g,maxlen=5,dyadic.tabulation="sum") pc$path.count #Examine path counts pc$paths.bydyad #Examine dyadic paths #Obtain aggregate cycle counts, with co-membership by length cc<-kcycle.census(g,maxlen=5,tabulate.by.vertex=FALSE, cycle.comembership="bylength") cc$cycle.count #Examine cycle counts cc$cycle.comemb[1,,] #Co-membership for 2-cycles cc$cycle.comemb[2,,] #Co-membership for 3-cycles cc$cycle.comemb[3,,] #Co-membership for 4-cycles } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ math }% __ONLY ONE__ keyword per line sna/man/plot.bbnam.Rd0000644000176200001440000000370011176527424014142 0ustar liggesusers\name{plot.bbnam} \alias{plot.bbnam} \alias{plot.bbnam.fixed} \alias{plot.bbnam.pooled} \alias{plot.bbnam.actor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plotting for bbnam Objects} \description{ Generates various plots of posterior draws from the \code{\link{bbnam}} model. } \usage{ \method{plot}{bbnam}(x, mode="density", intlines=TRUE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ A \code{bbnam} object } \item{mode}{ ``density'' for kernel density estimators of posterior marginals; otherwise, histograms are used } \item{intlines}{ Plot lines for the 0.9 central posterior probability intervals? } \item{\dots}{ Additional arguments to \code{\link{plot}} } } \details{ \code{plot.bbnam} provides plots of the estimated posterior marginals for the criterion graph and error parameters (as appropriate). Plotting may run into difficulties when dealing with large graphs, due to the problem of getting all of the various plots on the page; the routine handles these issues reasonably intelligently, but there is doubtless room for improvement. } \value{ None } \references{Butts, C.T. (1999). ``Informant (In)Accuracy and Network Estimation: A Bayesian Approach.'' CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}}} \examples{ #Create some random data g<-rgraph(5) g.p<-0.8*g+0.2*(1-g) dat<-rgraph(5,5,tprob=g.p) #Define a network prior pnet<-matrix(ncol=5,nrow=5) pnet[,]<-0.5 #Define em and ep priors pem<-matrix(nrow=5,ncol=2) pem[,1]<-3 pem[,2]<-5 pep<-matrix(nrow=5,ncol=2) pep[,1]<-3 pep[,2]<-5 #Draw from the posterior b<-bbnam(dat,model="actor",nprior=pnet,emprior=pem,epprior=pep, burntime=100,draws=100) #Print a summary of the posterior draws summary(b) #Plot the result plot(b) } \keyword{ hplot}%-- one or more ... sna/man/plot.equiv.clust.Rd0000644000176200001440000000342211176527355015351 0ustar liggesusers\name{plot.equiv.clust} \alias{plot.equiv.clust} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plot an equiv.clust Object } \description{ Plots a hierarchical clustering of node positions as generated by \code{\link{equiv.clust}}. } \usage{ \method{plot}{equiv.clust}(x, labels=NULL, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An \code{\link{equiv.clust}} object } \item{labels}{ A vector of vertex labels } \item{\dots}{ Additional arguments to \code{\link{plot.hclust}} } } \details{ \code{plot.equiv.clust} is actually a front-end to \code{\link{plot.hclust}}; see the latter for more additional documentation. } \value{ None. } \references{ Breiger, R.L.; Boorman, S.A.; and Arabie, P. (1975). ``An Algorithm for Clustering Relational Data with Applications to Social Network Analysis and Comparison with Multidimensional Scaling.'' \emph{Journal of Mathematical Psychology}, 12, 328-383. Burt, R.S. (1976). ``Positions in Networks.'' \emph{Social Forces}, 55, 93-122. Wasserman, S., and Faust, K. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\section{Requires}{\code{mva}} \seealso{ \code{\link{equiv.clust}}, \code{\link{plot.hclust}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Cluster based on structural equivalence eq<-equiv.clust(g) plot(eq) } \keyword{ hplot }%-- one or more ... sna/man/rgbn.Rd0000644000176200001440000002422614667252374013053 0ustar liggesusers\name{rgbn} \alias{rgbn} \alias{bn_cftp_R} \alias{bn_mcmc_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Draw from a Skvoretz-Fararo Biased Net Process } \description{ Produces a series of draws from a Skvoretz-Fararo biased net process using a Markov chain Monte Carlo or exact sampling procedure. } \usage{ rgbn(n, nv, param = list(pi=0, sigma=0, rho=0, d=0.5, delta=0, epsilon=0), burn = nv*nv*5*100, thin = nv*nv*5, maxiter = 1e7, method = c("mcmc","cftp"), dichotomize.sib.effects = FALSE, return.as.edgelist = FALSE, seed.graph = NULL, max.density = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{ number of draws to take. } \item{nv}{ number of vertices in the graph to be simulated. } \item{param}{ a list containing the biased net parameters (as described below); \eqn{d} and \eqn{epsilon} may be given as scalars or as \code{nv x nv} matrices of edgewise event probabilities.} \item{burn}{ for the MCMC, the number of burn-in draws to take (and discard). } \item{thin}{ the thinning parameter for the MCMC algorithm. } \item{maxiter}{ for the CFTP method, the number of iterations to try before giving up.} \item{method}{ \code{"mcmc"} for the MCMC, or \code{"cftp"} for the exact sampling procedure.} \item{dichotomize.sib.effects}{ logical; should sibling and double role effects be dichotomized?} \item{return.as.edgelist}{ logical; should the simulated draws be returned in edgelist format?} \item{seed.graph}{ optionally, an initial state to use for MCMC.} \item{max.density}{ optional maximum density threshold for MCMC; if the chain encounters a graph of higher than max density, the chain is terminated (and the result flagged). } } \details{ The biased net model stems from early work by Rapoport, who attempted to model networks via a hypothetical \dQuote{tracing} process. This process may be described loosely as follows. One begins with a small \dQuote{seed} set of vertices, each member of which is assumed to nominate (generate ties to) other members of the population with some fixed probability. These members, in turn, may nominate new members of the population, as well as members who have already been reached. Such nominations may be \dQuote{biased} in one fashion or another, leading to a non-uniform growth process. While the original biased net model depends upon the tracing process, a local (conditional) interpretation was put forward by Skvoretz and colleagues (2004). Using a four-parameter model, they propose approximating the conditional probability of an \eqn{(i,j)} edge given all other edges in a random graph \eqn{G} by \deqn{ \Pr(i \to j|G_{-ij}) \approx 1 - (1-\rho)^z (1-\sigma)^y (1-\pi)^x (1-d_{ij}) }{% Pr(i->j | G_{-ij}) apx 1 - (1-rho)^z (1-sigma)^y (1-pi)^x (1-d_{ij}) } where \eqn{x=1} iff \eqn{j \to i} (and 0 otherwise), \eqn{y} is the number of vertices \eqn{k \neq i,j}{k!=i,j} such that \eqn{k \to i, k \to j}{k->i, k->j}, and \eqn{z=1} iff \eqn{x=1} and \eqn{y>0} (and 0 otherwise). Thus, \eqn{x} is the number of potential \emph{parent bias} events, \eqn{y} is the number of potential \emph{sibling bias} events, and \eqn{z} is the number of potential \emph{double role bias} events. \eqn{d_{ij}} is the probability of the baseline edge event; note that an edge arises if the baseline event or any bias event occurs, and all events are assumed conditionally independent. Written in this way, it is clear that the edges of \eqn{G} are conditionally independent if they share no endpoint. Thus, a model with the above structure should be a subfamily of the Markov graphs. One problem with the above structure is that the hypothetical probabilities implied by the model are not in general consistent - that is, there exist conditions under which there is no joint pmf for \eqn{G} with the implied full conditionals. The interpretation of the above as exact conditional probabilities is thus potentially problematic. However, a well-defined process can be constructed by interpreting the above as transition probabilities for a Markov chain that evolves by updating a randomly selected edge variable at each time point; this is a Gibbs sampler for the implied joint pmf where it exists, and otherwise an irreducible and aperiodic Markov chain with a well-defined equilibrium distribution (Butts, 2018). In the above process, all events act to promote the formation of edges; it is also possible to define events that inhibit them (Butts, 2024). Let an \emph{inhibition} event be one that, if it occurs, forbids the creation of an \eqn{i \to j}{i->j}. As with \eqn{d}, we may specify a total probability \eqn{\epsilon_{ij}}{epsilon_{ij}} that such an event occurs exogenously for the \eqn{i,j} edge. We may also specify endogenous inhibition events. For instance, consider a \emph{satiation} event, which has the potential to occur every time \eqn{i} emits an edge to some other vertex; each existing edge has a chance of triggering \dQuote{satiation,} in which case the focal edge is inhibited. The associated approximate conditional (i.e., transition probability) with these effects is then \deqn{ \Pr(i \to j|G_{-ij}) \approx (1-\epsilon_{ij}) (1-\delta)^w\left(1 - (1-\rho)^z (1-\sigma)^y (1-\pi)^x (1-d_{ij})\right) }{% Pr(i->j | G_{-ij}) apx (1-epsilon_{ij}) (1-delta)^w [1 - (1-rho)^z (1-sigma)^y (1-pi)^x (1-d_{ij})] } where \eqn{w} is the outdegree of \eqn{i} in \eqn{G_{-ij}} and \eqn{\delta}{delta} is the probability of the satiation event. The net effect of satiation is to suppress edge formation (in roughly geometric fashion) on high degree nodes. This may be useful in preventing degeneracy when using sigma and rho effects. Degeneracy can also be reduced by employing the \code{dichotomize.sib.effects} argument, which counts only the first shared partner's contribution towards sibling and double role effects. It should be noted that the above process is not entirely consistent with the tracing-based model, which is itself not uniformly well-specified in the literature. For this reason, the local model is referred to here as a Skvoretz-Fararo or Markovian biased net graph process. One significant advantage of this process is that it is well-defined, and easily simulated: the above equation can be used to form the transition rule for a Markov chain Monte Carlo algorithm, which is used by \eqn{rgbn} to take draws from the (local) biased net model. (Note that while the underlying Markov chain is only a Gibbs sampler in the special cases for which the putative conditional distributions are jointly satisfiable, it \emph{always} can be interpreted as simulating draws from the equilibrium distribution of a SF/MBN graph process.) Burn-in and thinning are controlled by the corresponding arguments; since degeneracy is common with models of this type, it is advisable to check for adequate mixing. An alternative simulation strategy is the exact sampling procedure of Butts (2018), which employs a form of coupling from the past (CFTP). The CFTP method generates exact, independent draws from the equilibrium distribution of the biased net process (up to numerical limits), but can be slow to attain coalescence (and does not currently support satiation events or other inhibition events). Setting \code{maxiter} to smaller values limits the search depth employed, at the possible cost of biasing the resulting sample. An initial condition may be specified for the MCMC using the \code{seed.graph}; if not specified, the empty graph is used. For some applications (e.g., ABC rejection sampling), it can be useful to terminate simulation if the density is obviously too high for the draw to be useful. (Compare to similar functionality in the \code{ergm} \dQuote{density guard} feature.) This can be invoked for the MCMC algorithm by setting the \code{max.density} less than 1. In this case, the chain is terminated as soon as the threshold density is reached. The resulting object is marked with an attribute called \code{early.termination} with a value of \code{TRUE}, which should obviously be checked if this feature is used (since the terminated draws are not from the target distribution - especially if \code{n>1}!). This feature cannot be used with CFTP, and is ignored when CFTP is selected. } \value{ An adjacency array or list of sna edgelists containing the simulated graphs. } \references{ Butts, C.T. (2018). \dQuote{A Perfect Sampling Method for Exponential Family Random Graph Models.} \emph{Journal of Mathematical Sociology}, 42(1), 17-36. Butts, C.T. (2024). \dQuote{A Return to Biased Nets: New Specifications and Approximate Bayesian Inference.} \emph{Journal of Mathematical Sociology}. Rapoport, A. (1957). \dQuote{A Contribution to the Theory of Random and Biased Nets.} \emph{Bulletin of Mathematical Biophysics,} 15, 523-533. Skvoretz, J.; Fararo, T.J.; and Agneessens, F. (2004). \dQuote{Advances in Biased Net Theory: Definitions, Derivations, and Estimations.} \emph{Social Networks,} 26, 113-139. } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{bn}} } \examples{ #Generate draws with low density and no biases g1<-rgbn(50,10,param=list(pi=0, sigma=0, rho=0, d=0.17)) apply(dyad.census(g1),2,mean) #Examine the dyad census #Add a reciprocity bias g2<-rgbn(50,10,param=list(pi=0.5, sigma=0, rho=0, d=0.17)) apply(dyad.census(g2),2,mean) #Compare with g1 #Alternately, add a sibling bias g3<-rgbn(50,10,param=list(pi=0.0, sigma=0.3, rho=0, d=0.17)) mean(gtrans(g3)) #Compare transitivity scores mean(gtrans(g1)) #Create a two-group model with homophily x<-rbinom(30,1,0.5) #Generate group labels d<-0.02+outer(x,x,"==")*0.2 #Set base tie probability g4<-rgbn(1,30,param=list(pi=0.25, sigma=0.02, rho=0, d=d)) gplot(g4, vertex.col=1+x) #Note the group structure #Create a two-group model where cross-group ties are inhibited x<-rbinom(30,1,0.5) #Generate group labels ep<-outer(x,x,"!=")*0.75 #Set inhibition probability g5<-rgbn(1,30,param=list(pi=0.5, sigma=0.05, rho=0, d=0.1, epsilon=ep)) gplot(g5, vertex.col=1+x) #Note the group structure } \keyword{ distribution }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/summary.netcancor.Rd0000644000176200001440000000141611176706330015553 0ustar liggesusers\name{summary.netcancor} \alias{summary.netcancor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of netcancor Objects } \description{ Returns a \code{netcancor} summary object } \usage{ \method{summary}{netcancor}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{netcancor} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ % %} \value{ An object of class \code{summary.netcancor} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu}~ } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{netcancor}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/summary.bayes.factor.Rd0000644000176200001440000000143011176706406016157 0ustar liggesusers\name{summary.bayes.factor} \alias{summary.bayes.factor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of Bayes Factor Objects } \description{ Returns a \code{bayes.factor} summary object. } \usage{ \method{summary}{bayes.factor}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{bayes.factor} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} \value{ An object of class \code{summary.bayes.factor} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam.bf}} } %\examples{ %} \keyword{ math }%-- one or more ... sna/man/bicomponent.dist.Rd0000644000176200001440000000460013573634653015373 0ustar liggesusers\name{bicomponent.dist} \Rdversion{1.1} \alias{bicomponent.dist} \alias{bicomponents_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Calculate the Bicomponents of a Graph } \description{ \code{bicomponent.dist} returns the bicomponents of an input graph, along with size distribution and membership information. } \usage{ bicomponent.dist(dat, symmetrize = c("strong", "weak")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ a graph or graph stack. } \item{symmetrize}{ symmetrization rule to apply when pre-processing the input (see \code{\link{symmetrize}}). } } \details{ The bicomponents of undirected graph \code{G} are its maximal 2-connected vertex sets. \code{bicomponent.dist} calculates the bicomponents of \eqn{G}, after first coercing to undirected form using the symmetrization rule in \code{symmetrize}. In addition to bicomponent memberships, various summary statistics regarding the bicomponent distribution are returned; see below. } \value{ A list containing \item{members }{A list, with one entry per bicomponent, containing component members.} \item{memberships }{A vector of component memberships, by vertex. (Note: memberships may not be unique.) Vertices not belonging to any bicomponent have membership values of \code{NA}.} \item{csize }{A vector of component sizes, by bicomponent.} \item{cdist }{A vector of length \eqn{|V(G)|} with the (unnormalized) empirical distribution function of bicomponent sizes.} } \references{ Brandes, U. and Erlebach, T. (2005). \emph{Network Analysis: Methodological Foundations.} Berlin: Springer. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Remember that bicomponents can intersect; when this occurs, the relevant vertices' entries in the membership vector are assigned to one of the overlapping bicomponents on an arbitrary basis. The \code{members} element of the return list is the safe way to recover membership information. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{component.dist}}, \code{\link{cutpoints}}, \code{\link{symmetrize}} } \examples{ #Draw a moderately sparse graph g<-rgraph(25,tp=2/24,mode="graph") #Compute the bicomponents bicomponent.dist(g) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/netlogit.Rd0000644000176200001440000001257212743242565013743 0ustar liggesusers\name{netlogit} \alias{netlogit} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Logistic Regression for Network Data } \description{ \code{netlogit} performs a logistic regression of the network variable in \code{y} on the network variables in set \code{x}. The resulting fits (and coefficients) are then tested against the indicated null hypothesis. } \usage{ netlogit(y, x, intercept=TRUE, mode="digraph", diag=FALSE, nullhyp=c("qap", "qapspp", "qapy", "qapx", "qapallx", "cugtie", "cugden", "cuguman", "classical"), test.statistic = c("z-value","beta"), tol=1e-7, reps=1000) } %- maybe also `usage' for other objects documented here. \arguments{ \item{y}{ dependent network variable. \code{NA}s are allowed, and the data should be dichotomous. } \item{x}{ the stack of independent network variables. Note that \code{NA}s are permitted, as is dichotomous data. } \item{intercept}{logical; should an intercept term be fitted?} \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{nullhyp}{ string indicating the particular null hypothesis against which to test the observed estimands. } \item{test.statistic}{string indicating the test statistic to be used for the Monte Carlo procedures.} \item{tol}{ tolerance parameter for \code{qr.solve}. } \item{reps}{ integer indicating the number of draws to use for quantile estimation. (Relevant to the null hypothesis test only -- the analysis itself is unaffected by this parameter.) Note that, as for all Monte Carlo procedures, convergence is slower for more extreme quantiles. By default, \code{reps}=1000. } } \details{ \code{netlogit} is primarily a front-end to the built-in \code{\link{glm.fit}} routine. \code{netlogit} handles vectorization, sets up \code{\link{glm}} options, and deals with null hypothesis testing; the actual fitting is taken care of by \code{\link{glm.fit}}. Logistic network regression using is directly analogous to standard logistic regression elementwise on the appropriately vectorized adjacency matrices of the networks involved. As such, it is often a more appropriate model for fitting dichotomous response networks than is linear network regression. Because of the frequent presence of row/column/block autocorrelation in network data, classical hull hypothesis tests (and associated standard errors) are generally suspect. Further, it is sometimes of interest to compare fitted parameter values to those arising from various baseline models (e.g., uniform random graphs conditional on certain observed statistics). The tests supported by \code{netlogit} are as follows: \describe{ \item{\code{classical}}{ tests based on classical asymptotics. } \item{\code{cug}}{conditional uniform graph test (see \code{\link{cugtest}}) controlling for order.} \item{\code{cugden}}{conditional uniform graph test, controlling for order and density.} \item{\code{cugtie}}{conditional uniform graph test, controlling for order and tie distribution.} \item{\code{qap}}{QAP permutation test (see \code{\link{qaptest}}); currently identical to \code{qapspp}. } \item{\code{qapallx}}{QAP permutation test, using independent x-permutations.} \item{\code{qapspp}}{QAP permutation test, using Dekker's \dQuote{semi-partialling plus} procedure. } \item{\code{qapx}}{QAP permutation test, using (single) x-permutations.} \item{\code{qapy}}{QAP permutation test, using y-permutations.} } Note that interpretation of quantiles for single coefficients can be complex in the presence of multicollinearity or third variable effects. Although \code{qapspp} is known to be robust to these conditions in the OLS case, there are no equivalent results for logistic regression. Caution is thus advised. The statistic to be employed in the above tests may be selected via \code{test.statistic}. By default, the z-statistic (rather than estimated coefficient) is used, as this is more approximately pivotal; coefficient-based tests are not recommended for QAP null hypotheses, although they are provided here for legacy purposes. Reasonable printing and summarizing of \code{netlogit} objects is provided by \code{\link{print.netlogit}} and \code{\link{summary.netlogit}}, respectively. No plot methods exist at this time. } \value{ An object of class \code{netlogit} } \references{Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{} % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{glm}}, \code{\link{netlm}} } \examples{ \dontrun{ #Create some input graphs x<-rgraph(20,4) #Create a response structure y.l<-x[1,,]+4*x[2,,]+2*x[3,,] #Note that the fourth graph is #unrelated y.p<-apply(y.l,c(1,2),function(a){1/(1+exp(-a))}) y<-rgraph(20,tprob=y.p) #Fit a netlogit model nl<-netlogit(y,x,reps=100) #Examine the results summary(nl) } } \keyword{ regression }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/component.dist.Rd0000644000176200001440000001400513573640220015043 0ustar liggesusers\name{component.dist} \alias{component.dist} \alias{component.largest} \alias{undirComponents_R} \alias{component_dist_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Calculate the Component Size Distribution of a Graph } \description{ \code{component.dist} returns a list containing a vector of length \code{n} such that the \code{i}th element contains the number of components of graph \eqn{G} having size \code{i}, and a vector of length \code{n} giving component membership (where \code{n} is the graph order). Component strength is determined by the \code{connected} parameter; see below for details. \code{component.largest} identifies the component(s) of maximum order within graph \code{G}. It returns either a \code{logical} vector indicating membership in a maximum component or the adjacency matrix of the subgraph of \eqn{G} induced by the maximum component(s), as determined by \code{result}. Component strength is determined as per \code{component.dist}. } \usage{ component.dist(dat, connected=c("strong","weak","unilateral", "recursive")) component.largest(dat, connected=c("strong","weak","unilateral", "recursive"), result = c("membership", "graph"), return.as.edgelist = FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{connected}{ a string selecting strong, weak, unilateral or recursively connected components; by default, \code{"strong"} components are used.} \item{result}{ a string indicating whether a vector of membership indicators or the induced subgraph of the component should be returned. } \item{return.as.edgelist}{ logical; if \code{result=="graph"}, should the resulting structure be returned in edgelist form?} } \details{ Components are maximal sets of mutually connected vertices; depending on the definition of ``connected'' one employs, one can arrive at several types of components. Those supported here are as follows (in increasing order of restrictiveness): \enumerate{ \item \code{weak}: \eqn{v_1} is connected to \eqn{v_2} iff there exists a semi-path from \eqn{v_1} to \eqn{v_2} (i.e., a path in the weakly symmetrized graph) \item \code{unilateral}: \eqn{v_1} is connected to \eqn{v_2} iff there exists a directed path from \eqn{v_1} to \eqn{v_2} \emph{or} a directed path from \eqn{v_2} to \eqn{v_1} \item \code{strong}: \eqn{v_1} is connected to \eqn{v_2} iff there exists a directed path from \eqn{v_1} to \eqn{v_2} \emph{and} a directed path from \eqn{v_2} to \eqn{v_1} \item \code{recursive}: \eqn{v_1} is connected to \eqn{v_2} iff there exists a vertex sequence \eqn{v_a,\ldots,v_z}{v_a,...,v_z} such that \eqn{v_1,v_a,\ldots,v_z,v_2}{v_1,v_a,...,v_z,v_2} and \eqn{v_2,v_z,\ldots,v_a,v_1}{v_2,v_z,...,v_a,v_1} are directed paths } Note that the above definitions are distinct for directed graphs only; if \code{dat} is symmetric, then the \code{connected} parameter has no effect. } \value{ For \code{component.dist}, a list containing: \item{membership }{A vector of component memberships, by vertex} \item{csize}{A vector of component sizes, by component} \item{cdist}{A vector of length |V(G)| with the (unnormalized) empirical distribution function of component sizes} If multiple input graphs are given, the return value is a list of lists. For \code{component.largest}, either a \code{logical} vector of component membership indicators or the adjacency matrix/edgelist of the subgraph induced by the largest component(s) is returned. If multiple graphs were given as input, a list of results is returned. } \references{ West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \section{Note}{Unilaterally connected component partitions may not be well-defined, since it is possible for a given vertex to be unilaterally connected to two vertices that are not unilaterally connected with one another. Consider, for instance, the graph \eqn{a \rightarrow b \leftarrow c \rightarrow d}{a->b<-c<-d}. In this case, the maximal unilateral components are \eqn{ab} and \eqn{bcd}, with vertex \eqn{b} properly belonging to both components. For such graphs, a unique partition of vertices by component does not exist, and we ``solve'' the problem by allocating each ``problem vertex'' to one of its components on an essentially arbitrary basis. (\code{component.dist} generates a warning when this occurs.) It is recommended that the \code{unilateral} option be avoided where possible. Do not make the mistake of assuming that the subgraphs returned by \code{component.largest} are necessarily connected. This is \emph{usually} the case, but depends upon the uniqueness of the largest component. } \seealso{ \code{\link{components}}, \code{\link{symmetrize}}, \code{\link{reachability}} \code{\link{geodist}} } \examples{ g<-rgraph(20,tprob=0.06) #Generate a sparse random graph #Find weak components cd<-component.dist(g,connected="weak") cd$membership #Who's in what component? cd$csize #What are the component sizes? #Plot the size distribution plot(1:length(cd$cdist),cd$cdist/sum(cd$cdist),ylim=c(0,1),type="h") lgc<-component.largest(g,connected="weak") #Get largest component gplot(g,vertex.col=2+lgc) #Plot g, with component membership #Plot largest component itself gplot(component.largest(g,connected="weak",result="graph")) #Find strong components cd<-component.dist(g,connected="strong") cd$membership #Who's in what component? cd$csize #What are the component sizes? #Plot the size distribution plot(1:length(cd$cdist),cd$cdist/sum(cd$cdist),ylim=c(0,1),type="h") lgc<-component.largest(g,connected="strong") #Get largest component gplot(g,vertex.col=2+lgc) #Plot g, with component membership #Plot largest component itself gplot(component.largest(g,connected="strong",result="graph")) } \keyword{ math }%-- one or more ... \keyword{ graphs } sna/man/gplot3d.layout.Rd0000644000176200001440000002403514363664734015011 0ustar liggesusers\name{gplot3d.layout} \alias{gplot3d.layout} \alias{gplot3d.layout.adj} \alias{gplot3d.layout.eigen} \alias{gplot3d.layout.fruchtermanreingold} \alias{gplot3d.layout.geodist} \alias{gplot3d.layout.hall} \alias{gplot3d.layout.kamadakawai} \alias{gplot3d.layout.mds} \alias{gplot3d.layout.princoord} \alias{gplot3d.layout.random} \alias{gplot3d.layout.rmds} \alias{gplot3d.layout.segeo} \alias{gplot3d.layout.seham} \alias{gplot3d_layout_fruchtermanreingold_R} \alias{gplot3d_layout_kamadakawai_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Vertex Layout Functions for gplot3d } \description{ Various functions which generate vertex layouts for the \code{\link{gplot3d}} visualization routine. } \usage{ gplot3d.layout.adj(d, layout.par) gplot3d.layout.eigen(d, layout.par) gplot3d.layout.fruchtermanreingold(d, layout.par) gplot3d.layout.geodist(d, layout.par) gplot3d.layout.hall(d, layout.par) gplot3d.layout.kamadakawai(d, layout.par) gplot3d.layout.mds(d, layout.par) gplot3d.layout.princoord(d, layout.par) gplot3d.layout.random(d, layout.par) gplot3d.layout.rmds(d, layout.par) gplot3d.layout.segeo(d, layout.par) gplot3d.layout.seham(d, layout.par) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{d}{ an adjacency matrix, as passed by \code{\link{gplot3d}}. } \item{layout.par}{ a list of parameters. } } \details{ Like \code{\link{gplot}}, \code{\link{gplot3d}} allows for the use of arbitrary vertex layout algorithms via the \code{gplot3d.layout.*} family of routines. When called, \code{\link{gplot3d}} searches for a \code{gplot3d.layout} function whose third name matches its \code{mode} argument (see \code{\link{gplot3d}} help for more information); this function is then used to generate the layout for the resulting plot. In addition to the routines documented here, users may add their own layout functions as needed. The requirements for a \code{gplot3d.layout} function are as follows: \enumerate{ \item the first argument, \code{d}, must be the (dichotomous) graph adjacency matrix; \item the second argument, \code{layout.par}, must be a list of parameters (or \code{NULL}, if no parameters are specified); and \item the return value must be a real matrix of dimension \code{c(3,NROW(d))}, whose rows contain the vertex coordinates. } Other than this, anything goes. (In particular, note that \code{layout.par} could be used to pass additional matrices, if needed.) The \code{gplot3d.layout} functions currently supplied by default are as follows: \describe{ \item{eigen}{ This function places vertices based on the eigenstructure of the adjacency matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ This argument controls the matrix to be used for the eigenanalysis. \code{"symupper"}, \code{"symlower"}, \code{"symstrong"}, \code{"symweak"} invoke \code{\link{symmetrize}} on \code{d} with the respective symmetrizing rule. \code{"user"} indicates a user-supplied matrix (see below), while \code{"raw"} indicates that \code{d} should be used as-is. (Defaults to \code{"raw"}.)} \item{\code{layout.par$evsel}}{ If \code{"first"}, the first three eigenvectors are used; if \code{"size"}, the three eigenvectors whose eigenvalues have the largest magnitude are used instead. Note that only the real portion of the associated eigenvectors is used. (Defaults to \code{"first"}.)} \item{\code{layout.par$mat}}{ If \code{layout.par$var=="user"}, this matrix is used for the eigenanalysis. (No default.)} } } \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: \describe{ \item{\code{layout.par$niter}}{ This argument controls the number of iterations to be employed. (Defaults to 300.) } \item{\code{layout.par$max.delta}}{ Sets the maximum change in position for any given iteration. (Defaults to \code{NROW(d)}.)} \item{\code{layout.par$volume}}{ Sets the "volume" parameter for the F-R algorithm. (Defaults to \code{NROW(d)^3}.)} \item{\code{layout.par$cool.exp}}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} \item{\code{layout.par$repulse.rad}}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{volume*NROW(d)}.)} \item{\code{layout.par$seed.coord}}{ A three-column matrix of initial vertex coordinates. (Defaults to a random spherical layout.) } } } \item{hall}{ This function places vertices based on the last three eigenvectors of the Laplacian of the input matrix (Hall's algorithm). It takes no arguments.} \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: \describe{ \item{\code{layout.par$niter}}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } \item{\code{layout.par$sigma}}{ Sets the base standard deviation of position change proposals. (Defaults to \code{NROW(d)/4}.)} \item{\code{layout.par$initemp}}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} \item{\code{layout.par$cool.exp}}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} \item{\code{layout.par$kkconst}}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{NROW(d)^3}.)} \item{\code{layout.par$elen}}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{d} after symmetrizing, capped at \code{sqrt(NROW(d))}.)} \item{\code{layout.par$seed.coord}}{ A three-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } } } \item{mds}{ This function places vertices based on a metric multidimensional scaling of a specified distance matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ This argument controls the raw variable matrix to be used for the subsequent distance calculation and scaling. \code{"rowcol"}, \code{"row"}, and \code{"col"} indicate that the rows and columns (concatenated), rows, or columns (respectively) of \code{d} should be used. \code{"rcsum"} and \code{"rcdiff"} result in the sum or difference of \code{d} and its transpose being employed. \code{"invadj"} indicates that \code{max{d}-d} should be used, while \code{"geodist"} uses \code{\link{geodist}} to generate a matrix of geodesic distances from \code{d}. Alternately, an arbitrary matrix can be provided using \code{"user"}. (Defaults to \code{"rowcol"}.)} \item{\code{layout.par$dist}}{ The distance function to be calculated on the rows of the variable matrix. This must be one of the \code{method} parameters to \code{\link{dist}} (\code{"euclidean"}, \code{"maximum"}, \code{"manhattan"}, or \code{"canberra"}), or else \code{"none"}. In the latter case, no distance function is calculated, and the matrix in question must be square (with dimension \code{dim(d)}) for the routine to work properly. (Defaults to \code{"euclidean"}.)} \item{\code{layout.par$exp}}{ The power to which distances should be raised prior to scaling. (Defaults to 2.)} \item{\code{layout.par$vm}}{ If \code{layout.par$var=="user"}, this matrix is used for the distance calculation. (No default.)} } Note: the following layout functions are based on \code{mds}: \describe{ \item{adj}{ scaling of the raw adjacency matrix, treated as similarities (using \code{"invadj"}).} \item{geodist}{ scaling of the matrix of geodesic distances.} \item{rmds}{ euclidean scaling of the rows of \code{d}.} \item{segeo}{ scaling of the squared euclidean distances between row-wise geodesic distances (i.e., approximate structural equivalence).} \item{seham}{ scaling of the Hamming distance between rows/columns of \code{d} (i.e., another approximate structural equivalence scaling).} } } \item{princoord}{ This function places vertices based on the eigenstructure of a given correlation/covariance matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ The matrix of variables to be used for the correlation/covariance calculation. \code{"rowcol"}, \code{"col"}, and \code{"row"} indicate that the rows/cols, columns, or rows (respectively) of \code{d} should be employed. \code{"rcsum"} \code{"rcdiff"} result in the sum or difference of \code{d} and \code{t(d)} being used. \code{"user"} allows for an arbitrary variable matrix to be supplied. (Defaults to \code{"rowcol"}.)} \item{\code{layout.par$cor}}{ Should the correlation matrix (rather than the covariance matrix) be used? (Defaults to \code{TRUE}.)} \item{\code{layout.par$vm}}{ If \code{layout.par$var=="user"}, this matrix is used for the correlation/covariance calculation. (No default.)} } } \item{random}{ This function places vertices randomly. It takes the following argument: \describe{ \item{\code{layout.par$dist}}{ The distribution to be used for vertex placement. Currently, the options are \code{"unif"} (for uniform distribution on the unit cube), \code{"uniang"} (for a ``gaussian sphere'' configuration), and \code{"normal"} (for a straight Gaussian distribution). (Defaults to \code{"unif"}.)} } } } } \value{ A matrix whose rows contain the x,y,z coordinates of the vertices of \code{d}. } \references{ Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by Force-directed Placement.} \emph{Software - Practice and Experience,} 21(11):1129-1164. Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot3d}}, \code{\link{gplot}}, \code{\link{gplot.layout}}, \code{\link{cmdscale}}, \code{\link{eigen}} } %\examples{ %} \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ dplot }% __ONLY ONE__ keyword per line sna/man/stresscent.Rd0000644000176200001440000000677313573636735014331 0ustar liggesusers\name{stresscent} \alias{stresscent} \alias{stresscent_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Stress Centrality Scores of Network Positions } \description{ \code{stresscent} takes one or more graphs (\code{dat}) and returns the stress centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, stress on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ stresscent(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, cmode="directed", geodist.precomp=NULL, rescale=FALSE, ignore.eval=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ Integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g==1}. } \item{nodes}{ list indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{gmode} is set to \code{"digraph"} by default.} \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{cmode}{ string indicating the type of betweenness centrality being computed (directed or undirected geodesics). } \item{geodist.precomp}{a \code{\link{geodist}} object precomputed for the graph to be analyzed (optional). } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; should edge values be ignored when calculating density?} } \details{ The stress of a vertex, v, is given by \deqn{C_S(v) = \sum_{i,j : i \neq j,i \neq v,j \neq v} g_{ivj}}{% C_S(v) = sum( g_ivj, i,j: i!=j,i!=v,j!=v)} where \eqn{g_{ijk}}{g_ijk} is the number of geodesics from i to k through j. Conceptually, high-stress vertices lie on a large number of shortest paths between other vertices; they can thus be thought of as ``bridges'' or ``boundary spanners.'' Compare this with \code{\link{betweenness}}, which weights shortest paths by the inverse of their redundancy. } \value{ A vector, matrix, or list containing the centrality scores (depending on the number and size of the input graphs). } \references{ Shimbel, A. (1953). ``Structural Parameters of Communication Networks.'' \emph{Bulletin of Mathematical Biophysics,} 15:501-507. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Judicious use of \code{geodist.precomp} can save a great deal of time when computing multiple path-based indices on the same network. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{centralization}}} \examples{ g<-rgraph(10) #Draw a random graph with 10 members stresscent(g) #Compute stress scores } \keyword{univar} \keyword{ math } \keyword{ graphs } sna/man/hierarchy.Rd0000644000176200001440000000766510501711235014064 0ustar liggesusers\name{hierarchy} \alias{hierarchy} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute Graph Hierarchy Scores } \description{ \code{hierarchy} takes a graph set (\code{dat}) and returns reciprocity or Krackhardt hierarchy scores for the graphs selected by \code{g}. } \usage{ hierarchy(dat, g=NULL, measure=c("reciprocity", "krackhardt")) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{a stack of input graphs. } \item{g}{ index values for the graphs to be utilized; by default, all graphs are selected. } \item{measure}{ one of \code{"reciprocity"} or \code{"krackhardt"}. } } \details{ Hierarchy measures quantify the extent of asymmetry in a structure; the greater the extent of asymmetry, the more hierarchical the structure is said to be. (This should not be confused with how \emph{centralized} the structure is, i.e., the extent to which centralities of vertex positions are highly concentrated.) \code{hierarchy} provides two measures (selected by the \code{measure} argument) as follows: \enumerate{ \item \code{reciprocity}: This setting returns one minus the dyadic reciprocity for each input graph (see \code{\link{grecip}}) \item \code{krackhardt}: This setting returns the Krackhardt hierarchy score for each input graph. The Krackhardt hierarchy is defined as the fraction of non-null dyads in the \code{\link{reachability}} graph which are asymmetric. Thus, when no directed paths are reciprocated (e.g., in an in/outtree), Krackhardt hierarchy is equal to 1; when all such paths are reciprocated, by contrast (e.g., in a cycle or clique), the measure falls to 0. Hierarchy is one of four measures (\code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, and \code{\link{lubness}}) suggested by Krackhardt for summarizing hierarchical structures. Each corresponds to one of four axioms which are necessary and sufficient for the structure in question to be an outtree; thus, the measures will be equal to 1 for a given graph iff that graph is an outtree. Deviations from unity can be interpreted in terms of failure to satisfy one or more of the outtree conditions, information which may be useful in classifying its structural properties. } Note that hierarchy is inherently density-constrained: as densities climb above 0.5, the proportion of mutual dyads must (by the pigeonhole principle) increase rapidly, thereby reducing possibilities for asymmetry. Thus, the interpretation of hierarchy scores should take density into account, particularly if density is artifactual (e.g., due to a particular dichotomization procedure). } \value{ A vector of hierarchy scores } \references{ Krackhardt, David. (1994). ``Graph Theoretical Dimensions of Informal Organizations.'' In K. M. Carley and M. J. Prietula (Eds.), \emph{Computational Organization Theory}, 89-111. Hillsdale, NJ: Lawrence Erlbaum and Associates. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The four Krackhardt indices are, in general, nondegenerate for a relatively narrow band of size/density combinations (efficiency being the sole exception). This is primarily due to their dependence on the reachability graph, which tends to become complete rapidly as size/density increase. See Krackhardt (1994) for a useful simulation study. } \seealso{ \code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, \code{\link{lubness}}, \code{\link{grecip}}, \code{\link{mutuality}}, \code{\link{dyad.census}} } \examples{ #Get hierarchy scores for graphs of varying densities hierarchy(rgraph(10,5,tprob=c(0.1,0.25,0.5,0.75,0.9)), measure="reciprocity") hierarchy(rgraph(10,5,tprob=c(0.1,0.25,0.5,0.75,0.9)), measure="krackhardt") } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ univar }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/rguman.Rd0000644000176200001440000000735011176526003013374 0ustar liggesusers\name{rguman} \alias{rguman} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Draw Dyad Census-Conditioned Random Graphs } \description{ \code{rguman} generates random draws from a dyad census-conditioned uniform random graph distribution. } \usage{ rguman(n, nv, mut = 0.25, asym = 0.5, null = 0.25, method = c("probability", "exact"), return.as.edgelist = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{ the number of graphs to generate. } \item{nv}{ the size of the vertex set (\eqn{|V(G)|}) for the random graphs. } \item{mut}{ if \code{method=="probability"}, the probability of obtaining a mutual dyad; otherwise, the number of mutual dyads. } \item{asym}{ if \code{method=="probability"}, the probability of obtaining an asymmetric dyad; otherwise, the number of asymmetric dyads. } \item{null}{ if \code{method=="probability"}, the probability of obtaining a null dyad; otherwise, the number of null dyads. } \item{method}{ the generation method to use. \code{"probability"} results in a multinomial dyad distribution (conditional on the underlying rates), while \code{"exact"} results in a uniform draw conditional on the exact dyad distribution. } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in edgelist form?} } \details{ A simple generalization of the Erdos-Renyi family, the U|MAN distributions are uniform on the set of graphs, conditional on order (size) and the dyad census. As with the E-R case, there are two U|MAN variants. The first (corresponding to \code{method=="probability"}) takes dyad states as independent multinomials with parameters \eqn{m} (for mutuals), \eqn{a} (for asymmetrics), and \eqn{n} (for nulls). The resulting pmf is then \deqn{ p(G=g|m,a,n) = \frac{(M+A+N)!}{M!A!N!} m^M a^A n^N, }{% p(G=g|m,a,n) = (M+A+N)!/(M!A!N!) m^M a^A n^N, } where \eqn{M}, \eqn{A}, and \eqn{N} are realized counts of mutual, asymmetric, and null dyads, respectively. (See \code{\link{dyad.census}} for an explication of dyad types.) The second U|MAN variant is selected by \code{method=="exact"}, and places equal mass on all graphs having the specified (exact) dyad census. The corresponding pmf is \deqn{ p(G=g|M,A,N) = \frac{M!A!N!}{(M+A+N)!}. }{% p(G=g|M,A,N) = M!A!N!/(M+A+N)!. } U|MAN graphs provide a natural baseline model for networks which are constrained by size, density, and reciprocity. In this way, they provide a bridge between edgewise models (e.g., the E-R family) and models with higher order dependence (e.g., the Markov graphs). } \value{ A matrix or array containing the drawn adjacency matrices } \references{ Holland, P.W. and Leinhardt, S. (1976). \dQuote{Local Structure in Social Networks.} In D. Heise (Ed.), \emph{Sociological Methodology}, pp 1-45. San Francisco: Jossey-Bass. Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The famous mathematicians referenced in this man page now have misspelled names, due to R's difficulty with accent marks. } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{rgraph}}, \code{\link{rgnm}}, \code{\link{dyad.census}} } \examples{ #Show some examples of extreme U|MAN graphs gplot(rguman(1,10,mut=45,asym=0,null=0,method="exact")) #Clique gplot(rguman(1,10,mut=0,asym=45,null=0,method="exact")) #Tournament gplot(rguman(1,10,mut=0,asym=0,null=45,method="exact")) #Empty #Draw a sample of multinomial U|MAN graphs g<-rguman(5,10,mut=0.15,asym=0.05,null=0.8) #Examine the dyad census dyad.census(g) } \keyword{ distribution }% at least one, from doc/KEYWORDS \keyword{ graphs}% __ONLY ONE__ keyword per line sna/man/sedist.Rd0000644000176200001440000000650410501711234013367 0ustar liggesusers\name{sedist} \alias{sedist} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find a Matrix of Distances Between Positions Based on Structural Equivalence } \description{ \code{sedist} uses the graphs indicated by \code{g} in \code{dat} to assess the extent to which each vertex is structurally equivalent; \code{joint.analysis} determines whether this analysis is simultaneous, and \code{method} determines the measure of approximate equivalence which is used. } \usage{ sedist(dat, g=c(1:dim(dat)[1]), method="hamming", joint.analysis=FALSE, mode="digraph", diag=FALSE, code.diss=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a graph or set thereof. } \item{g}{ a vector indicating which elements of \code{dat} should be examined. } \item{method}{ one of \code{"correlation"}, \code{"euclidean"}, \code{"hamming"}, or \code{"gamma"}.} \item{joint.analysis}{ should equivalence be assessed across all networks jointly (\code{TRUE}), or individually within each (\code{FALSE})? } \item{mode}{ \code{"digraph"} for directed data, otherwise \code{"graph"}. } \item{diag}{ boolean indicating whether diagonal entries (loops) should be treated as meaningful data. } \item{code.diss}{ reverse-code the raw comparison values.} } \details{ \code{sedist} provides a basic tool for assessing the (approximate) structural equivalence of actors. (Two vertices i and j are said to be structurally equivalent if i->k iff j->k for all k.) SE similarity/difference scores are computed by comparing vertex rows and columns using the measure indicated by \code{method}: \enumerate{ \item correlation: the product-moment correlation \item euclidean: the euclidean distance \item hamming: the Hamming distance \item gamma: the gamma correlation } Once these similarities/differences are calculated, the results can be used with a clustering routine (such as \code{\link{equiv.clust}}) or an MDS (such as \code{\link{cmdscale}}). } \value{ A matrix of similarity/difference scores } \references{Breiger, R.L.; Boorman, S.A.; and Arabie, P. (1975). ``An Algorithm for Clustering Relational Data with Applications to Social Network Analysis and Comparison with Multidimensional Scaling.'' \emph{Journal of Mathematical Psychology}, 12, 328-383. Burt, R.S. (1976). ``Positions in Networks.'' \emph{Social Forces}, 55, 93-122. Wasserman, S., and Faust, K. \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Be careful to verify that you have computed what you meant to compute, with respect to similarities/differences. Also, note that (despite its popularity) the product-moment correlation can give rather strange results in some cases. } \seealso{ \code{\link{equiv.clust}}, \code{\link{blockmodel}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Get SE distances g.se<-sedist(g) #Plot a metric MDS of vertex positions in two dimensions plot(cmdscale(as.dist(g.se))) } \keyword{ classif } \keyword{ cluster }%-- one or more ... \keyword{ math } \keyword{ graphs} sna/man/centralgraph.Rd0000644000176200001440000000350710501711235014547 0ustar liggesusers\name{centralgraph} \alias{centralgraph} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Central Graph of a Labeled Graph Stack } \description{ Returns the central graph of a set of labeled graphs, i.e. that graph in which i->j iff i->j in >=50\% of the graphs within the set. If \code{normalize==TRUE}, then the value of the i,jth edge is given as the proportion of graphs in which i->j. } \usage{ centralgraph(dat, normalize=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{normalize}{ boolean indicating whether the results should be normalized. The result of this is the "mean matrix". By default, \code{normalize==FALSE}.} } \details{ The central graph of a set of graphs S is that graph C which minimizes the sum of Hamming distances between C and G in S. As such, it turns out (for the dichotomous case, at least), to be analogous to both the mean and median for sets of graphs. The central graph is useful in a variety of contexts; see the references below for more details. } \value{ A matrix containing the central graph (or mean matrix) } \references{ Banks, D.L., and Carley, K.M. (1994). ``Metric Inference for Social Networks.'' \emph{Journal of Classification}, 11(1), 121-49. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ 0.5 is used as the cutoff value regardless of whether or not the data is dichotomous (as is tacitly assumed). The routine is unaffected by data type when \code{normalize==TRUE}. } \seealso{ \code{\link{hdist}} } \examples{ #Generate some random graphs dat<-rgraph(10,5) #Find the central graph cg<-centralgraph(dat) #Plot the central graph gplot(cg) #Now, look at the mean matrix cg<-centralgraph(dat,normalize=TRUE) print(cg) } \keyword{ math }%-- one or more ... \keyword{ graphs} sna/man/netlm.Rd0000644000176200001440000001442611176515435013233 0ustar liggesusers\name{netlm} \alias{netlm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Linear Regression for Network Data } \description{ \code{netlm} regresses the network variable in \code{y} on the network variables in stack \code{x} using ordinary least squares. The resulting fits (and coefficients) are then tested against the indicated null hypothesis. } \usage{ netlm(y, x, intercept=TRUE, mode="digraph", diag=FALSE, nullhyp=c("qap", "qapspp", "qapy", "qapx", "qapallx", "cugtie", "cugden", "cuguman", "classical"), test.statistic = c("t-value", "beta"), tol=1e-7, reps=1000) } %- maybe also `usage' for other objects documented here. \arguments{ \item{y}{ dependent network variable. This should be a matrix, for obvious reasons; NAs are allowed, but dichotomous data is strongly discouraged due to the assumptions of the analysis. } \item{x}{ stack of independent network variables. Note that NAs are permitted, as is dichotomous data. } \item{intercept}{ logical; should an intercept term be added? } \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default. } \item{diag}{ logical; should the diagonal be treated as valid data? Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{nullhyp}{ string indicating the particular null hypothesis against which to test the observed estimands. } \item{test.statistic}{ string indicating the test statistic to be used for the Monte Carlo procedures.} \item{tol}{ tolerance parameter for \code{\link{qr.solve}}. } \item{reps}{ integer indicating the number of draws to use for quantile estimation. (Relevant to the null hypothesis test only - the analysis itself is unaffected by this parameter.) Note that, as for all Monte Carlo procedures, convergence is slower for more extreme quantiles. By default, \code{reps}=1000. } } \details{ \code{netlm} performs an OLS linear network regression of the graph \code{y} on the graphs in \code{x}. Network regression using OLS is directly analogous to standard OLS regression elementwise on the appropriately vectorized adjacency matrices of the networks involved. In particular, the network regression attempts to fit the model: \deqn{\mathbf{A_y} = b_0 \mathbf{A_1} + b_1 \mathbf{A_{x_1}} + b_2 \mathbf{A_{x_2}} + \dots + \mathbf{Z}}{% A_y = b_0 A_1 + b_1 A_x1 + b_2 A_x2 + \dots + Z} where \eqn{\mathbf{A_y}}{A_y} is the dependent adjacency matrix, \eqn{\mathbf{A_{x_i}}}{A_xi} is the ith independent adjacency matrix, \eqn{\mathbf{A_1}}{A_1} is an n x n matrix of 1's, and \eqn{\mathbf{Z}}{Z} is an n x n matrix of independent normal random variables with mean 0 and variance \eqn{\sigma^2}{sigma^2}. Clearly, this model is nonoptimal when \eqn{\mathbf{A_y}}{A_y} is dichotomous (or, for that matter, categorical in general); an alternative such as \code{netlogit} should be employed in such cases. (Note that \code{netlm} will still attempt to fit such data...the user should consider him or herself to have been warned.) Because of the frequent presence of row/column/block autocorrelation in network data, classical hull hypothesis tests (and associated standard errors) are generally suspect. Further, it is sometimes of interest to compare fitted parameter values to those arising from various baseline models (e.g., uniform random graphs conditional on certain observed statistics). The tests supported by \code{netlm} are as follows: \describe{ \item{\code{classical}}{ tests based on classical asymptotics. } \item{\code{cug}}{conditional uniform graph test (see \code{\link{cugtest}}) controlling for order.} \item{\code{cugden}}{conditional uniform graph test, controlling for order and density.} \item{\code{cugtie}}{conditional uniform graph test, controlling for order and tie distribution.} \item{\code{qap}}{QAP permutation test (see \code{\link{qaptest}}); currently identical to \code{qapspp}. } \item{\code{qapallx}}{QAP permutation test, using independent x-permutations.} \item{\code{qapspp}}{QAP permutation test, using Dekker's "semi-partialling plus" procedure. } \item{\code{qapx}}{QAP permutation test, using (single) x-permutations.} \item{\code{qapy}}{QAP permutation test, using y-permutations.} } The statistic to be employed in the above tests may be selected via \code{test.statistic}. By default, the \eqn{t}-statistic (rather than estimated coefficient) is used, as this is more approximately pivotal; coefficient-based tests are not recommended for QAP null hypotheses, although they are provided here for legacy purposes. Note that interpretation of quantiles for single coefficients can be complex in the presence of multicollinearity or third variable effects. \code{qapspp} is generally recommended for most multivariable analyses, as it is known to be fairly robust to these conditions. Reasonable printing and summarizing of \code{netlm} objects is provided by \code{\link{print.netlm}} and \code{\link{summary.netlm}}, respectively. No plot methods exist at this time, alas. } \value{ An object of class \code{netlm} } \references{ Dekker, D.; Krackhardt, D.; Snijders, T.A.B. (2007). \dQuote{Sensitivity of MRQAP Tests to Collinearity and Autocorrelation Conditions.} \emph{Psychometrika}, 72(4), 563-581. Dekker, D.; Krackhardt, D.; Snijders, T.A.B. (2003). \dQuote{Mulicollinearity Robust QAP for Multiple Regression.} CASOS Working Paper, Carnegie Mellon University. Krackhardt, D. (1987). \dQuote{QAP Partialling as a Test of Spuriousness.} \emph{Social Networks}, 9 171-186. Krackhardt, D. (1988). \dQuote{Predicting With Networks: Nonparametric Multiple Regression Analyses of Dyadic Data.} \emph{Social Networks}, 10, 359-382. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{lm}}, \code{\link{netlogit}} } \examples{ #Create some input graphs x<-rgraph(20,4) #Create a response structure y<-x[1,,]+4*x[2,,]+2*x[3,,] #Note that the fourth graph is unrelated #Fit a netlm model nl<-netlm(y,x,reps=100) #Examine the results summary(nl) } \keyword{ regression }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/triad.classify.Rd0000644000176200001440000001100413573637067015031 0ustar liggesusers\name{triad.classify} \alias{triad.classify} \alias{triad_classify_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Davis and Leinhardt Classification of a Given Triad } \description{ \code{triad.classify} returns the Davis and Leinhardt classification of the triad indicated by \code{tri} in the \code{g}th graph of stack \code{dat}. } \usage{ triad.classify(dat, g=1, tri=c(1, 2, 3), mode=c("digraph", "graph")) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a graph or graph stack. } \item{g}{ the index of the graph to be analyzed. } \item{tri}{ a triple containing the indices of the triad to be classified.} \item{mode}{string indicating the directedness of edges; \code{"digraph"} implies a directed structure, whereas \code{"graph"} implies an undirected structure.} } \details{ Every unoriented directed triad may occupy one of 16 distinct states. These states were used by Davis and Leinhardt as a basis for classifying triads within a larger structure; the distribution of triads within a graph (see \code{\link{triad.census}}), for instance, is linked to a range of substantive hypotheses (e.g., concerning structural balance). The Davis and Leinhardt classification scheme describes each triad by a string of four elements: the number of mutual (complete) dyads within the triad; the number of asymmetric dyads within the triad; the number of null (empty) dyads within the triad; and a configuration code for the triads which are not uniquely distinguished by the first three distinctions. The complete list of classes is as follows. \describe{ \item{\code{003}}{ \eqn{a \not\leftrightarrow b \not\leftrightarrow c, a \not\leftrightarrow c}{a<-!->b<-!->c, a<-!->c}} \item{\code{012}}{ \eqn{a \rightarrow b \not\leftrightarrow c, a \not\leftrightarrow c}{a-->b<-!->c, a<-!->c}} \item{\code{102}}{ \eqn{a \leftrightarrow b \not\leftrightarrow c, a \not\leftrightarrow c}{a<-->b<-!->c, a<-!->c}} \item{\code{021D}}{ \eqn{a \leftarrow b \rightarrow c, a \not\leftrightarrow c}{a<--b-->c, a<-!->c}} \item{\code{021U}}{ \eqn{a \rightarrow b \leftarrow c, a \not\leftrightarrow c}{a-->b<--c, a<-!->c}} \item{\code{021C}}{ \eqn{a \rightarrow b \rightarrow c, a \not\leftrightarrow c}{a-->b-->c, a<-!->c}} \item{\code{111D}}{ \eqn{a \not\leftrightarrow b \rightarrow c, a \leftrightarrow c}{a<-!->b-->c, a<-->c}} \item{\code{111U}}{ \eqn{a \not\leftrightarrow b \leftarrow c, a \leftrightarrow c}{a<-!->b-->c, a<-->c}} \item{\code{030T}}{ \eqn{a \rightarrow b \leftarrow c, a \rightarrow c}{a-->b<--c, a-->c}} \item{\code{030C}}{ \eqn{a \leftarrow b \leftarrow c, a \rightarrow c}{a<--b<--c, a-->c}} \item{\code{201}}{ \eqn{a \leftrightarrow b \not\leftrightarrow c, a \leftrightarrow c}{a<-->b<-!->c, a<-->c}} \item{\code{120D}}{ \eqn{a \leftarrow b \rightarrow c, a \leftrightarrow c}{a<--b-->c, a<-->c}} \item{\code{120U}}{ \eqn{a \rightarrow b \leftarrow c, a \leftrightarrow c}{a-->b<--c, a<-->c}} \item{\code{120C}}{ \eqn{a \rightarrow b \rightarrow c, a \leftrightarrow c}{a-->b-->c, a<-->c}} \item{\code{210}}{ \eqn{a \rightarrow b \leftrightarrow c, a \leftrightarrow c}{a-->b<-->c, a<-->c}} \item{\code{300}}{ \eqn{a \leftrightarrow b \leftrightarrow c, a \leftrightarrow c}{a<-->b<-->c, a<-->c}} } These codes are returned by \code{triad.classify} as strings. In the undirected case, only four triad states are possible (corresponding to the number of edges in the triad). These are evaluated for \code{mode=="graph"}, with the return value being the number of edges. } \value{ A string containing the triad classification, or \code{NA} if one or more edges were missing } \references{ Davis, J.A. and Leinhardt, S. (1972). ``The Structure of Positive Interpersonal Relations in Small Groups.'' In J. Berger (Ed.), \emph{Sociological Theories in Progress, Volume 2}, 218-251. Boston: Houghton Mifflin. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } \seealso{ \code{\link{triad.census}}, \code{\link{gtrans}} } \section{Warning }{Valued data and/or loops may cause strange behavior with this routine. Dichotomize/remove loops first.} \examples{ #Generate a random graph g<-rgraph(10) #Classify the triads (1,2,3) and (2,3,4) triad.classify(g,tri=c(1,2,3)) triad.classify(g,tri=c(1,2,3)) #Plot the triads in question gplot(g[1:3,1:3]) gplot(g[2:4,2:4]) } \keyword{ math }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/cutpoints.Rd0000644000176200001440000000733313573635631014147 0ustar liggesusers\name{cutpoints} \Rdversion{1.1} \alias{cutpoints} \alias{cutpointsDir_R} \alias{cutpointsUndir_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Identify the Cutpoints of a Graph or Digraph } \description{ \code{cutpoints} identifies the cutpoints of an input graph. Depending on \code{mode}, either a directed or undirected notion of \dQuote{cutpoint} can be used. } \usage{ cutpoints(dat, mode = "digraph", connected = c("strong","weak","recursive"), return.indicator = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} for undirected graphs. } \item{connected}{ string indicating the type of connectedness rule to apply (only relevant where \code{mode=="digraph"}). } \item{return.indicator}{ logical; should the results be returned as a logical (\code{TRUE/FALSE}) vector of indicators, rather than as a vector of vertex IDs? } } \details{ A \emph{cutpoint} (also known as an \emph{articulation point} or \emph{cut-vertex}) of an undirected graph, \eqn{G} is a vertex whose removal increases the number of components of \eqn{G}. Several generalizations to the directed case exist. Here, we define a \emph{strong cutpoint} of directed graph \eqn{G} to be a vertex whose removal increases the number of strongly connected components of \eqn{G} (see \code{\link{component.dist}}). Likewise, \emph{weak} and \emph{recursive} cutpoints of \emph{G} are those vertices whose removal increases the number of weak or recursive cutpoints (respectively). By default, strong cutpoints are used; alternatives may be selected via the \code{connected} argument. Cutpoints are of particular interest when seeking to identify critical positions in flow networks, since their removal by definition alters the connectivity properties of the graph. In this context, cutpoint status can be thought of as a primitive form of centrality (with some similarities to \code{\link{betweenness}}). Cutpoint computation is significantly faster for the undirected case (and for the weak/recursive cases) than for the strong directed case. While calling \code{cutpoints} with \code{mode="digraph"} on an undirected graph will give the same answer as \code{mode="graph"}, it is thus to one's advantage to use the latter form. Do not, however, employ \code{mode="graph"} with directed data, unless you enjoy unpredictable behavior. } \value{ A vector of cutpoints (if \code{return.indicator==FALSE}), or else a logical vector indicating cutpoint status for each vertex. } \references{ Berge, Claude. (1966). \emph{The Theory of Graphs.} New York: John Wiley and Sons. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{component.dist}}, \code{\link{bicomponent.dist}}, \code{\link{betweenness}} } \examples{ #Generate some sparse random graph gd<-rgraph(25,tp=1.5/24) #Directed gu<-rgraph(25,tp=1.5/24,mode="graph") #Undirected #Calculate the cutpoints (as an indicator vector) cpu<-cutpoints(gu,mode="graph",return.indicator=TRUE) cpd<-cutpoints(gd,return.indicator=TRUE) #Plot the result gplot(gu,gmode="graph",vertex.col=2+cpu) gplot(gd,vertex.col=2+cpd) #Repeat with alternate connectivity modes cpdw<-cutpoints(gd,connected="weak",return.indicator=TRUE) cpdr<-cutpoints(gd,connected="recursive",return.indicator=TRUE) #Visualize the difference gplot(gd,vertex.col=2+cpdw) gplot(gd,vertex.col=2+cpdr) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/print.qaptest.Rd0000644000176200001440000000131711176542077014725 0ustar liggesusers\name{print.qaptest} \alias{print.qaptest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for qaptest Objects } \description{ Prints a quick summary of objects produced by \code{\link{qaptest}}. } \usage{ \method{print}{qaptest}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{qaptest} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{qaptest}}} %\examples{ %} \keyword{ print }%-- one or more ... sna/man/print.summary.bayes.factor.Rd0000644000176200001440000000142111176542063017307 0ustar liggesusers\name{print.summary.bayes.factor} \alias{print.summary.bayes.factor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.bayes.factor Objects } \description{ Prints an object of class \code{summary.bayes.factor}. } \usage{ \method{print}{summary.bayes.factor}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.bayes.factor} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.bayes.factor}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/sna.Rd0000644000176200001440000001133414236326413012664 0ustar liggesusers\name{sna} \alias{sna} %\docType{data} \title{Tools for Social Network Analysis} \description{ \code{sna} is a package containing a range of tools for social network analysis. Supported functionality includes node and graph-level indices, structural distance and covariance methods, structural equivalence detection, p* modeling, random graph generation, and 2D/3D network visualization (among other things). } %\usage{data(sna)} %\format{ % The format is: % logi NA %} \details{ Network data for \code{sna} routines can (except as noted otherwise) appear in any of the following forms: \itemize{ \item adjacency matrices (dimension N x N); \item arrays of adjacency matrices, aka \dQuote{graph stacks} (dimension m x N x N); \item sna edge lists (see below); \item sparse matrix objects (from the SparseM package); \item \code{network} objects (from the \link[network]{network} package); or \item lists of adjacency matrices/arrays, sparse matrices, and/or \code{network} objects. } Within the package documentation, the term \dQuote{graph} is used generically to refer to any or all of the above (with multiple graphs being referred to as a \dQuote{graph stack}). Note that usage of sparse matrix objects requires that the SparseM package be installed. (No additional packages are required for use of adjacency matrices/arrays or lists thereof, though the network package, on which sna depends as of 2.4, is used for network objects.) In general, \code{sna} routines attempt to make intelligent decisions regarding the processing of multiple graphs, but common sense is always advised; certain functions, in particular, have more specific data requirements. Calling \code{sna} functions with inappropriate input data can produce \dQuote{interesting} results. One special data type supported by the sna package (as of version 2.0) is the \emph{sna edgelist}. This is a simple data format that is well-suited to representing large, sparse graphs. (As of version 2.0, many - now most - package routines also process data in this form natively, so using it can produce significant savings of time and/or memory. Prior to 2.0, all package functions coerced input data to adjacency matrix form.) An sna edgelist is a three-column matrix, containing (respectively) senders, receivers, and values for each edge in the graph. (Unvalued edges should have a value of 1.) Note that this form is invariant to the number of edges in the graph: if there are no edges, then the edgelist is a degenerate matrix of dimension 0 by 3. Edgelists for undirected graphs should be coded as fully mutual digraphs (as would be the case with an adjacency matrix), with two edges per dyad (one (i,j) edge, and one (j,i) edge). Graph size for an sna edgelist matrix is indicated by a mandatory numeric attribute, named \code{"n"}. Vertex names may be optionally specified by a vector-valued attribute named \code{"vnames"}. In the case of two-mode data (i.e., data with an enforced bipartition), it is possible to indicate this status via the optional \code{"bipartite"} attribute. Vertices in a two-mode edgelist should be grouped in mode order, with \code{"n"} equal to the total number of vertices (across both modes) and \code{"bipartite"} equal to the number of vertices in the first mode. Direct creation of sna edgelists can be performed by creating a three-column matrix and using the \code{\link{attr}} function to create the required \code{"n"} attribute. Alternately, the function \code{\link{as.edgelist.sna}} can be used to coerce data in any of the above forms to an sna edgelist. By turns, the function \code{\link{as.sociomatrix.sna}} can be used to convert any of these data types to adjacency matrix form. To get started with \code{sna}, try obtaining viewing the list of available functions. This can be accomplished via the command \code{library(help=sna)}. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ If you use this package and/or software manual in your work, a citation would be appreciated. The \code{link{citation}} function has helpful information in this regard. See also the following paper, which explores the package in some detail: Butts, Carter T. (2008). \dQuote{Social Network Analysis with sna.} \emph{Journal of Statistical Software}, 24(6). If utilizing a contributed routine, please also consider recognizing the author(s) of that specific function. Contributing authors, if any, are listed on the relevant manual pages. Your support helps to encourage the growth of the \code{sna} package, and is greatly valued! } %\source{ % ~~ reference to a publication or URL from which the data were obtained ~~ %} %\references{ % ~~ possibly secondary sources and usages ~~ %} %\examples{ %data(sna) %## maybe str(sna) ; plot(sna) ... %} \keyword{graphs} \keyword{misc} sna/man/gplot.layout.Rd0000644000176200001440000003741714363663757014576 0ustar liggesusers\name{gplot.layout} \alias{gplot.layout} \alias{gplot.layout.adj} \alias{gplot.layout.circle} \alias{gplot.layout.circrand} \alias{gplot.layout.eigen} \alias{gplot.layout.fruchtermanreingold} \alias{gplot.layout.geodist} \alias{gplot.layout.hall} \alias{gplot.layout.kamadakawai} \alias{gplot.layout.mds} \alias{gplot.layout.princoord} \alias{gplot.layout.random} \alias{gplot.layout.rmds} \alias{gplot.layout.segeo} \alias{gplot.layout.seham} \alias{gplot.layout.spring} \alias{gplot.layout.springrepulse} \alias{gplot.layout.target} \alias{gplot_layout_fruchtermanreingold_R} \alias{gplot_layout_fruchtermanreingold_old_R} \alias{gplot_layout_kamadakawai_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Vertex Layout Functions for gplot } \description{ Various functions which generate vertex layouts for the \code{\link{gplot}} visualization routine. } \usage{ gplot.layout.adj(d, layout.par) gplot.layout.circle(d, layout.par) gplot.layout.circrand(d, layout.par) gplot.layout.eigen(d, layout.par) gplot.layout.fruchtermanreingold(d, layout.par) gplot.layout.geodist(d, layout.par) gplot.layout.hall(d, layout.par) gplot.layout.kamadakawai(d, layout.par) gplot.layout.mds(d, layout.par) gplot.layout.princoord(d, layout.par) gplot.layout.random(d, layout.par) gplot.layout.rmds(d, layout.par) gplot.layout.segeo(d, layout.par) gplot.layout.seham(d, layout.par) gplot.layout.spring(d, layout.par) gplot.layout.springrepulse(d, layout.par) gplot.layout.target(d, layout.par) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{d}{ an adjacency matrix, as passed by \code{\link{gplot}}. } \item{layout.par}{ a list of parameters. } } \details{ Vertex layouts for network visualization pose a difficult problem -- there is no single, ``good'' layout algorithm, and many different approaches may be valuable under different circumstances. With this in mind, \code{\link{gplot}} allows for the use of arbitrary vertex layout algorithms via the \code{gplot.layout.*} family of routines. When called, \code{\link{gplot}} searches for a \code{gplot.layout} function whose third name matches its \code{mode} argument (see \code{\link{gplot}} help for more information); this function is then used to generate the layout for the resulting plot. In addition to the routines documented here, users may add their own layout functions as needed. The requirements for a \code{gplot.layout} function are as follows: \enumerate{ \item the first argument, \code{d}, must be the (dichotomous) graph adjacency matrix; \item the second argument, \code{layout.par}, must be a list of parameters (or \code{NULL}, if no parameters are specified); and \item the return value must be a real matrix of dimension \code{c(2,NROW(d))}, whose rows contain the vertex coordinates. } Other than this, anything goes. (In particular, note that \code{layout.par} could be used to pass additional matrices, if needed.) The \code{graph.layout} functions currently supplied by default are as follows: \describe{ \item{circle}{ This function places vertices uniformly in a circle; it takes no arguments.} \item{eigen}{ This function places vertices based on the eigenstructure of the adjacency matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ This argument controls the matrix to be used for the eigenanalysis. \code{"symupper"}, \code{"symlower"}, \code{"symstrong"}, \code{"symweak"} invoke \code{\link{symmetrize}} on \code{d} with the respective symmetrizing rule. \code{"user"} indicates a user-supplied matrix (see below), while \code{"raw"} indicates that \code{d} should be used as-is. (Defaults to \code{"raw"}.)} \item{\code{layout.par$evsel}}{ If \code{"first"}, the first two eigenvectors are used; if \code{"size"}, the two eigenvectors whose eigenvalues have the largest magnitude are used instead. Note that only the real portion of the associated eigenvectors is used. (Defaults to \code{"first"}.)} \item{\code{layout.par$mat}}{ If \code{layout.par$var=="user"}, this matrix is used for the eigenanalysis. (No default.)} } } \item{fruchtermanreingold}{ This function generates a layout using a variant of Fruchterman and Reingold's force-directed placement algorithm. It takes the following arguments: \describe{ \item{\code{layout.par$niter}}{ This argument controls the number of iterations to be employed. Larger values take longer, but will provide a more refined layout. (Defaults to 500.) } \item{\code{layout.par$max.delta}}{ Sets the maximum change in position for any given iteration. (Defaults to \code{n}.)} \item{\code{layout.par$area}}{ Sets the \dQuote{area} parameter for the F-R algorithm. (Defaults to \code{n^2}.)} \item{\code{layout.par$cool.exp}}{ Sets the cooling exponent for the annealer. (Defaults to 3.)} \item{\code{layout.par$repulse.rad}}{ Determines the radius at which vertex-vertex repulsion cancels out attraction of adjacent vertices. (Defaults to \code{area*log(n)}.)} \item{\code{layout.par$ncell}}{ To speed calculations on large graphs, the plot region is divided at each iteration into \code{ncell} by \code{ncell} \dQuote{cells}, which are used to define neighborhoods for force calculation. Moderate numbers of cells result in fastest performance; too few cells (down to 1, which produces \dQuote{pure} F-R results) can yield odd layouts, while too many will result in long layout times. (Defaults to \code{n^0.5}.)} \item{\code{layout.par$cell.jitter}}{ Jitter factor (in units of cell width) used in assigning vertices to cells. Small values may generate \dQuote{grid-like} anomalies for graphs with many isolates. (Defaults to \code{0.5}.)} \item{\code{layout.par$cell.pointpointrad}}{ Squared \dQuote{radius} (in units of cells) such that exact point interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart. Higher values approximate the true F-R solution, but increase computational cost. (Defaults to \code{0}.)} \item{\code{layout.par$cell.pointcellrad}}{ Squared \dQuote{radius} (in units of cells) such that approximate point/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point radius). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. (Defaults to \code{18}.)} \item{\code{layout.par$cell.cellcellrad}}{ Squared \dQuote{radius} (in units of cells) such that approximate cell/cell interaction calculations are used for all vertices belonging to any two cells less than or equal to this distance apart (and not within the point/point or point/cell radii). Higher values provide somewhat better approximations to the true F-R solution at slightly increased computational cost. Note that cells beyond this radius (if any) do not interact, save through edge attraction. (Defaults to \code{ncell^2}.)} \item{\code{layout.par$seed.coord}}{ A two-column matrix of initial vertex coordinates. (Defaults to a random circular layout.) } } } \item{hall}{ This function places vertices based on the last two eigenvectors of the Laplacian of the input matrix (Hall's algorithm). It takes no arguments.} \item{kamadakawai}{ This function generates a vertex layout using a version of the Kamada-Kawai force-directed placement algorithm. It takes the following arguments: \describe{ \item{\code{layout.par$niter}}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } \item{\code{layout.par$sigma}}{ Sets the base standard deviation of position change proposals. (Defaults to \code{NROW(d)/4}.)} \item{\code{layout.par$initemp}}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} \item{\code{layout.par$cool.exp}}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} \item{\code{layout.par$kkconst}}{ Sets the Kamada-Kawai vertex attraction constant. (Defaults to \code{NROW(d)^2}.)} \item{\code{layout.par$elen}}{ Provides the matrix of interpoint distances to be approximated. (Defaults to the geodesic distances of \code{d} after symmetrizing, capped at \code{sqrt(NROW(d))}.)} \item{\code{layout.par$seed.coord}}{ A two-column matrix of initial vertex coordinates. (Defaults to a gaussian layout.) } } } \item{mds}{ This function places vertices based on a metric multidimensional scaling of a specified distance matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ This argument controls the raw variable matrix to be used for the subsequent distance calculation and scaling. \code{"rowcol"}, \code{"row"}, and \code{"col"} indicate that the rows and columns (concatenated), rows, or columns (respectively) of \code{d} should be used. \code{"rcsum"} and \code{"rcdiff"} result in the sum or difference of \code{d} and its transpose being employed. \code{"invadj"} indicates that \code{max{d}-d} should be used, while \code{"geodist"} uses \code{\link{geodist}} to generate a matrix of geodesic distances from \code{d}. Alternately, an arbitrary matrix can be provided using \code{"user"}. (Defaults to \code{"rowcol"}.)} \item{\code{layout.par$dist}}{ The distance function to be calculated on the rows of the variable matrix. This must be one of the \code{method} parameters to \code{\link{dist}} (\code{"euclidean"}, \code{"maximum"}, \code{"manhattan"}, or \code{"canberra"}), or else \code{"none"}. In the latter case, no distance function is calculated, and the matrix in question must be square (with dimension \code{dim(d)}) for the routine to work properly. (Defaults to \code{"euclidean"}.)} \item{\code{layout.par$exp}}{ The power to which distances should be raised prior to scaling. (Defaults to 2.)} \item{\code{layout.par$vm}}{ If \code{layout.par$var=="user"}, this matrix is used for the distance calculation. (No default.)} } Note: the following layout functions are based on \code{mds}: \describe{ \item{adj}{ scaling of the raw adjacency matrix, treated as similarities (using \code{"invadj"}).} \item{geodist}{ scaling of the matrix of geodesic distances.} \item{rmds}{ euclidean scaling of the rows of \code{d}.} \item{segeo}{ scaling of the squared euclidean distances between row-wise geodesic distances (i.e., approximate structural equivalence).} \item{seham}{ scaling of the Hamming distance between rows/columns of \code{d} (i.e., another approximate structural equivalence scaling).} } } \item{princoord}{ This function places vertices based on the eigenstructure of a given correlation/covariance matrix. It takes the following arguments: \describe{ \item{\code{layout.par$var}}{ The matrix of variables to be used for the correlation/covariance calculation. \code{"rowcol"}, \code{"col"}, and \code{"row"} indicate that the rows/cols, columns, or rows (respectively) of \code{d} should be employed. \code{"rcsum"} \code{"rcdiff"} result in the sum or difference of \code{d} and \code{t(d)} being used. \code{"user"} allows for an arbitrary variable matrix to be supplied. (Defaults to \code{"rowcol"}.)} \item{\code{layout.par$cor}}{ Should the correlation matrix (rather than the covariance matrix) be used? (Defaults to \code{TRUE}.)} \item{\code{layout.par$vm}}{ If \code{layout.par$var=="user"}, this matrix is used for the correlation/covariance calculation. (No default.)} } } \item{random}{ This function places vertices randomly. It takes the following argument: \describe{ \item{\code{layout.par$dist}}{ The distribution to be used for vertex placement. Currently, the options are \code{"unif"} (for uniform distribution on the square), \code{"uniang"} (for a ``gaussian donut'' configuration), and \code{"normal"} (for a straight Gaussian distribution). (Defaults to \code{"unif"}.)} } Note: \code{circrand}, which is a frontend to the \code{"uniang"} option, is based on this function. } \item{spring}{ This function places vertices using a spring embedder. It takes the following arguments: \describe{ \item{\code{layout.par$mass}}{ The vertex mass (in ``quasi-kilograms''). (Defaults to \code{0.1}.)} \item{\code{layout.par$equil}}{ The equilibrium spring extension (in ``quasi-meters''). (Defaults to \code{1}.)} \item{\code{layout.par$k}}{ The spring coefficient (in ``quasi-Newtons per quasi-meter''). (Defaults to \code{0.001}.)} \item{\code{layout.par$repeqdis}}{ The point at which repulsion (if employed) balances out the spring extension force (in ``quasi-meters''). (Defaults to \code{0.1}.)} \item{\code{layout.par$kfr}}{ The base coefficient of kinetic friction (in ``quasi-Newton quasi-kilograms''). (Defaults to \code{0.01}.)} \item{\code{layout.par$repulse}}{ Should repulsion be used? (Defaults to \code{FALSE}.)} } Note: \code{springrepulse} is a frontend to \code{spring}, with repulsion turned on. } \item{target}{ This function produces a "target diagram" or "bullseye" layout, using a Brandes et al.'s force-directed placement algorithm. (See also \code{\link{gplot.target}}.) It takes the following arguments: \describe{ \item{\code{layout.par$niter}}{ This argument controls the number of iterations to be employed. (Defaults to 1000.) } \item{\code{layout.par$radii}}{ This argument should be a vector of length \code{NROW(d)} containing vertex radii. Ideally, these should lie in the [0,1] interval (and odd behavior may otherwise result). (Defaults to the affine-transformed Freeman \code{\link{degree}} centrality scores of \code{d}.) } \item{\code{layout.par$minlen}}{ Sets the minimum edge length, below which edge lengths are to be adjusted upwards. (Defaults to 0.05.) } \item{\code{layout.par$area}}{ Sets the initial "temperature" for the annealing algorithm. (Defaults to 10.)} \item{\code{layout.par$cool.exp}}{ Sets the cooling exponent for the annealer. (Defaults to 0.99.)} \item{\code{layout.par$maxdelta}}{ Sets the maximum angular distance for vertex moves. (Defaults to \code{pi}.)} \item{\code{layout.par$periph.outside}}{ Boolean; should "peripheral" vertices (in the Brandes et al. sense) be placed together outside the main target area? (Defaults to \code{FALSE}.)} \item{\code{layout.par$periph.outside.offset}}{ Radius at which to place "peripheral" vertices if \code{periph.outside==TRUE}. (Defaults to 1.2.)} \item{\code{layout.par$disconst}}{ Multiplier for the Kamada-Kawai-style distance potential. (Defaults to 1.)} \item{\code{layout.par$crossconst}}{ Multiplier for the edge crossing potential. (Defaults to 1.)} \item{\code{layout.par$repconst}}{ Multiplier for the vertex-edge repulsion potential. (Defaults to 1.)} \item{\code{layout.par$minpdis}}{ Sets the "minimum distance" parameter for vertex repulsion. (Defaults to 0.05.)} } } } } \value{ A matrix whose rows contain the x,y coordinates of the vertices of \code{d}. } \references{ Brandes, U.; Kenis, P.; and Wagner, D. (2003). \dQuote{Communicating Centrality in Policy Network Drawings.} \emph{IEEE Transactions on Visualization and Computer Graphics,} 9(2):241-253. Fruchterman, T.M.J. and Reingold, E.M. (1991). \dQuote{Graph Drawing by Force-directed Placement.} \emph{Software - Practice and Experience,} 21(11):1129-1164. Kamada, T. and Kawai, S. (1989). \dQuote{An Algorithm for Drawing General Undirected Graphs.} \emph{Information Processing Letters,} 31(1):7-15. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot}}, \code{\link{gplot.target}}, \code{\link{gplot3d.layout}}, \code{\link{cmdscale}}, \code{\link{eigen}} } %\examples{ %} \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ dplot }% __ONLY ONE__ keyword per line sna/man/plot.qaptest.Rd0000644000176200001440000000333411176535553014551 0ustar liggesusers\name{plot.qaptest} \alias{plot.qaptest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plotting for qaptest Objects } \description{ Plots the Distribution of a QAP Test Statistic. } \usage{ \method{plot}{qaptest}(x, mode="density", ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ A \code{\link{qaptest}} object } \item{mode}{ ``density'' for kernel density estimation, ``hist'' for histogram } \item{\dots}{ Additional arguments to \code{\link{plot}} } } \details{ In addition to the quantiles associated with a QAP test, it is often useful to examine the form of the distribution of the test statistic. \code{plot.qaptest} facilitates this. } \value{ None } \references{ Hubert, L.J., and Arabie, P. (1989). ``Combinatorial Data Analysis: Confirmatory Comparisons Between Sets of Matrices.'' \emph{Applied Stochastic Models and Data Analysis}, 5, 273-325. Krackhardt, D. (1987). ``QAP Partialling as a Test of Spuriousness.'' \emph{Social Networks}, 9 171-186. Krackhardt, D. (1988). ``Predicting With Networks: Nonparametric Multiple Regression Analyses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{qaptest}} } \examples{ #Generate three graphs g<-array(dim=c(3,10,10)) g[1,,]<-rgraph(10) g[2,,]<-rgraph(10,tprob=g[1,,]*0.8) g[3,,]<-1; g[3,1,2]<-0 #This is nearly a clique #Perform qap tests of graph correlation q.12<-qaptest(g,gcor,g1=1,g2=2) q.13<-qaptest(g,gcor,g1=1,g2=3) #Examine the results summary(q.12) plot(q.12) summary(q.13) plot(q.13) } \keyword{ hplot }%-- one or more ... sna/man/summary.lnam.Rd0000644000176200001440000000161511176530117014525 0ustar liggesusers\name{summary.lnam} \alias{summary.lnam} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Detailed Summaries of lnam Objects } \description{ Returns a \code{lnam} summary object. } \usage{ \method{summary}{lnam}(object, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ an object of class \code{lnam}. } \item{\dots}{ additional arguments. } } %\details{ % ~~ If necessary, more details than the __description__ above ~~ %} \value{ An object of class \code{summary.lnam}. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{lnam}} } %\examples{ %} \keyword{ methods }% at least one, from doc/KEYWORDS %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line sna/man/simmelian.Rd0000644000176200001440000000737213737005703014071 0ustar liggesusers\name{simmelian} \alias{simmelian} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Simmelian Tie Structure of a Graph } \description{ \code{simmelian} takes one or more (possibly directed) graphs as input, producing the associated Simmelian tie structures. } \usage{ simmelian(dat, dichotomize=TRUE, return.as.edgelist=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs (directed or otherwise). } \item{dichotomize}{ logical; should the presence or absence of Simmelian edges be returned? If \code{FALSE}, returned edges are valued by the number of 3-clique co-memberships for each dyad. } \item{return.as.edgelist}{ logical; return the result as an sna edgelist? } } \details{ For a digraph \eqn{G=(V,E)} with vertices \eqn{i} and \eqn{j}, then \eqn{i} and \eqn{j} are said to have a \emph{Simmelian tie} iff \eqn{i} and \eqn{j} belong to a 3-clique of \eqn{G}. (Note that, in the undirected case, we simply treat \eqn{G} as a fully mutual digraph.) Because they have both a mutual dyad and mutual ties to/from at least one third party, vertex pairs with Simmelian ties in interpersonal networks are often expected to have strong relationships; Simmelian ties may also be more stable than other relationships, due to reinforcement from the mutual shared partner. In other settings, the derived network of Simmelian ties (which is simply the co-membership network of non-trivial cliques) may be useful for identifying cohesively connected elements in a larger graph, or for finding \dQuote{backbone} structures in networks with large numbers of unreciprocated and/or bridging ties. Currently, Simmelian tie calculation is performed using \code{\link{kcycle.census}}. While the bulk of the calculations and data handling are performed using edgelists, \code{\link{kcycle.census}} currently returns co-memberships in adjacency form. The implication for the end user is that performance for \code{simmelian} will begin to degrade for networks on the order of ten thousand vertices or so (due to the cost of allocating the adjacency structure), irrespective of the content of the network or other settings. This bottleneck will likely be removed in future versions. } \value{ An adjacency matrix containing the Simmelian ties, or the equivalent edgelist representation } \references{ Krackhardt, David. (1999). \dQuote{The Ties That Torture: Simmelian Tie Analysis in Organizations.} \emph{Research in the Sociology of Organizations}, 16:183-210.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{kcycle.census}}, \code{\link{clique.census}} } \examples{ #Contrast the Simmelian ties in the Coleman friendship network with the "raw" ties data(coleman) fall<-coleman[1,,] #Fall ties spring<-coleman[2,,] #Spring ties sim.fall<-simmelian(coleman[1,,]) #Fall Simmelian ties sim.spring<-simmelian(coleman[2,,]) #Spring Simmelian ties par(mfrow=c(2,2)) gplot(fall,main="Nominations in Fall") gplot(spring,main="Nominations in Spring") gplot(sim.fall,main="Simmelian Ties in Fall") gplot(sim.spring,main="Simmelian Ties in Spring") #Which ties shall survive? table(fall=gvectorize(fall),spring=gvectorize(spring)) #Fall vs. spring table(sim.fall=gvectorize(sim.fall),spring=gvectorize(spring)) sum(fall&spring)/sum(fall) #About 58% of ties survive, overall... sum(sim.fall&spring)/sum(sim.fall) #...but 74% of Simmelian ties survive! sum(sim.fall&sim.spring)/sum(sim.fall) #(About 44% stay Simmelian.) sum(sim.fall&sim.spring)/sum(sim.spring) #39% of spring Simmelian ties were so in fall sum(fall&sim.spring)/sum(sim.spring) #and 67% had at least some tie in fall } \keyword{ algebra }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/betweenness.Rd0000644000176200001440000001665013573634630014441 0ustar liggesusers\name{betweenness} \alias{betweenness} \alias{betweenness_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute the Betweenness Centrality Scores of Network Positions } \description{ \code{betweenness} takes one or more graphs (\code{dat}) and returns the betweenness centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, betweenness on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ betweenness(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, cmode="directed", geodist.precomp=NULL, rescale=FALSE, ignore.eval=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{gmode} is set to "digraph" by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev}==\code{FALSE}. } \item{cmode}{ string indicating the type of betweenness centrality being computed (directed or undirected geodesics, or a variant form -- see below). } \item{geodist.precomp}{ A \code{\link{geodist}} object precomputed for the graph to be analyzed (optional) } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; ignore edge values when computing shortest paths?} } \details{ The shortest-path betweenness of a vertex, \eqn{v}, is given by \deqn{ C_B(v) = \sum_{i,j : i \neq j, i \neq v, j \neq v} \frac{g_{ivj}}{g_{ij}}}{% C_B(v) = sum( g_ivj / g_ij, i,j: i!=j,i!=v,j!=v )} where \eqn{g_{ijk}}{g_ijk} is the number of geodesics from \eqn{i} to \eqn{k} through \eqn{j}. Conceptually, high-betweenness vertices lie on a large number of non-redundant shortest paths between other vertices; they can thus be thought of as ``bridges'' or ``boundary spanners.'' Several variant forms of shortest-path betweenness exist, and can be selected using the \code{cmode} argument. Supported options are as follows: \describe{ \item{\code{directed}}{ Standard betweenness (see above), calculated on directed pairs. (This is the default option.)} \item{\code{undirected}}{ Standard betweenness (as above), calculated on undirected pairs (undirected graphs only).} \item{\code{endpoints}}{ Standard betweenness, with direct connections counted towards ego's score. This expresses the intuition that individuals' control over their own direct contacts should be considered in their total score (e.g., when betweenness is interpreted as a measure of information control).} \item{\code{proximalsrc}}{ Borgatti's \emph{proximal source betweenness,} given by \deqn{ C_B(v) = \sum_{i,j : i \neq v, i\neq j, j \to v} \frac{g_{ivj}}{g_{ij}}.}{% C_B(v) = sum( g_ivj / g_ij, i,j: i!=v,i!=j,j->v ).} This variant allows betweenness to accumulate only for the last intermediating vertex in each incoming geodesic; this expresses the notion that, by serving as the \dQuote{proximal source} for the target, this particular intermediary will in some settings have greater influence or control than other intervening parties. } \item{\code{proximaltar}}{ Borgatti's \emph{proximal target betweenness,} given by \deqn{ C_B(v) = \sum_{i,j : i \neq v, i\to v, i\neq j} \frac{g_{ivj}}{g_{ij}}.}{% C_B(v) = sum( g_ivj / g_ij, i,j: i!=j,i->v,j!=v ).} This counterpart to proximal source betweenness (above) allows betweenness to accumulate only for the first intermediating vertex in each outgoing geodesic; this expresses the notion that, by serving as the \dQuote{proximal target} for the source, this particular intermediary will in some settings have greater influence or control than other intervening parties. } \item{\code{proximalsum}}{The sum of Borgatti's proximal source and proximal target betweenness scores (above); this may be used when either role is regarded as relevant to the betweenness calculation.} \item{\code{lengthscaled}}{Borgetti and Everett's \emph{length-scaled betweenness}, given by \deqn{ C_B(v) = \sum_{i,j : i \neq j, i \neq v, j \neq v} \frac{1}{d_{ij}}\frac{g_{ivj}}{g_{ij}},}{% C_B(v) = sum( (1/d_ij)*(g_ivj / g_ij), i,j: i!=j,i!=v,j!=v ),} where \eqn{d_{ij}}{d_ij} is the geodesic distance from \eqn{i} to \eqn{j}. This measure adjusts the standard betweenness score by downweighting long paths (e.g., as appropriate in circumstances for which such paths are less-often used). } \item{\code{linearscaled}}{Geisberger et al.'s \emph{linearly-scaled betweenness}: \deqn{ C_B(v) = \sum_{i,j : i \neq j, i \neq v, j \neq v} \frac{1}{d_{ij}}\frac{g_{ivj}}{g_{ij}}.}{% C_B(v) = sum( (d_iv/d_ij)*(g_ivj / g_ij), i,j: i!=j,i!=v,j!=v ).} This variant modifies the standard betweenness score by giving more weight to intermediaries which are closer to their targets (much like proximal source betweenness, above). This may be of use when those near the end of a path have greater direct control over the flow of influence or resources than those near its source. } } See Brandes (2008) for details and additional references. Geodesics for all of the above can be calculated using valued edges by setting \code{ignore.eval=TRUE}. Edge values are interpreted as distances for this purpose; proximity data should be transformed accordingly before invoking this routine. } \value{ A vector, matrix, or list containing the betweenness scores (depending on the number and size of the input graphs). } \references{ Borgatti, S.P. and Everett, M.G. (2006). \dQuote{A Graph-Theoretic Perspective on Centrality.} \emph{Social Networks}, 28, 466-484. Brandes, U. (2008). \dQuote{On Variants of Shortest-Path Betweenness Centrality and their Generic Computation.} \emph{Social Networks}, 30, 136--145. Freeman, L.C. (1979). \dQuote{Centrality in Social Networks I: Conceptual Clarification.} \emph{Social Networks}, 1, 215-239. Geisberger, R., Sanders, P., and Schultes, D. (2008). \dQuote{Better Approximation of Betweenness Centrality.} In \emph{Proceedings of the 10th Workshop on Algorithm Engineering and Experimentation (ALENEX'08)}, 90-100. SIAM. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Judicious use of \code{geodist.precomp} can save a great deal of time when computing multiple path-based indices on the same network. } \section{Warning }{Rescale may cause unexpected results if all actors have zero betweenness.} \seealso{ \code{\link{centralization}}, \code{\link{stresscent}}, \code{\link{geodist}} } \examples{ g<-rgraph(10) #Draw a random graph with 10 members betweenness(g) #Compute betweenness scores } \keyword{univar} \keyword{ graphs } sna/man/lubness.Rd0000644000176200001440000000716713573637451013601 0ustar liggesusers\name{lubness} \alias{lubness} \alias{lubness_con_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute Graph LUBness Scores } \description{ \code{lubness} takes a graph set (\code{dat}) and returns the Krackhardt LUBness scores for the graphs selected by \code{g}. } \usage{ lubness(dat, g=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ index values for the graphs to be utilized; by default, all graphs are selected. } } \details{ In the context of a directed graph \eqn{G}, two actors \eqn{i} and \eqn{j} may be said to have an \emph{upper bound} iff there exists some actor \eqn{k} such that directed \eqn{ki} and \eqn{kj} paths belong to \eqn{G}. An upper bound \eqn{\ell}{l} is known as a \emph{least upper bound} for \eqn{i} and \eqn{j} iff it belongs to at least one \eqn{ki} and \eqn{kj} path (respectively) for all \eqn{i,j} upper bounds \eqn{k}; let \eqn{L(i,j)} be an indicator which returns 1 iff such an \eqn{\ell}{l} exists, otherwise returning 0. Now, let \eqn{G_1,G_2,\dots,G_n}{G_1,G_2,...,G_n} represent the weak components of \eqn{G}. For convenience, we denote the cardinalities of these graphs' vertex sets by \eqn{|V(G)|=N} and \eqn{|V(G_i)|=N_i}, \eqn{\forall i \in 1,\dots,n}{for i in 1,...,n}. Given this, the Krackhardt LUBness of \eqn{G} is given by \deqn{ 1-\frac{\sum_{i=1}^n \sum_{v_j,v_k \in V(G_i)} \Bigl(1-L(v_j,v_k)\Bigr)}{\sum_{i=1}^n \frac{1}{2}(N_i-1)(N_i-2)}}{% 1-Sum(Sum(1-L(v_j,v_k),v_j,v_k in V(G_i)),i=1,...,n)/Sum((N_i-1)(N_i-2)/2,i=1,...,n)} Where all vertex pairs possess a least upper bound, Krackhardt's LUBness is equal to 1; in general, it approaches 0 as this condition is broached. (This convergence is problematic in certain cases due to the requirement that we sum violations across components; where a graph contains no components of size three or greater, Krackhardt's LUBness is not well-defined. \code{lubness} returns a \code{NaN} in these cases.) LUBness is one of four measures (\code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, and \code{\link{lubness}}) suggested by Krackhardt for summarizing hierarchical structures. Each corresponds to one of four axioms which are necessary and sufficient for the structure in question to be an outtree; thus, the measures will be equal to 1 for a given graph iff that graph is an outtree. Deviations from unity can be interpreted in terms of failure to satisfy one or more of the outtree conditions, information which may be useful in classifying its structural properties. } \value{ A vector of LUBness scores } \references{ Krackhardt, David. (1994). ``Graph Theoretical Dimensions of Informal Organizations.'' In K. M. Carley and M. J. Prietula (Eds.), \emph{Computational Organization Theory}, 89-111. Hillsdale, NJ: Lawrence Erlbaum and Associates. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The four Krackhardt indices are, in general, nondegenerate for a relatively narrow band of size/density combinations (efficiency being the sole exception). This is primarily due to their dependence on the reachability graph, which tends to become complete rapidly as size/density increase. See Krackhardt (1994) for a useful simulation study. } \seealso{ \code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, \code{\link{lubness}}, \code{\link{reachability}} } \examples{ #Get LUBness scores for graphs of varying densities lubness(rgraph(10,5,tprob=c(0.1,0.25,0.5,0.75,0.9))) } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ univar }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/mutuality.Rd0000644000176200001440000000270410501711234014127 0ustar liggesusers\name{mutuality} \alias{mutuality} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Mutuality of a Graph } \description{ Returns the mutuality scores of the graphs indicated by \code{g} in \code{dat}. } \usage{ mutuality(dat, g=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ a vector indicating which elements of \code{dat} should be analyzed; by default, all graphs are included. } } \details{ The mutuality of a digraph G is defined as the number of complete dyads (i.e., i<->j) within G. (Compare this to dyadic reciprocity, the fraction of dyads within G which are symmetric.) Mutuality is commonly employed as a measure of reciprocal tendency within the p* literature; although mutuality can be very hard to interpret in practice, it is much better behaved than many alternative measures. } \value{ One or more mutuality scores } \references{ Moreno, J.L., and Jennings, H.H. (1938). ``Statistics of Social Configurations.'' \emph{Sociometry}, 1, 342-374. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{grecip}} } \examples{ #Create some random graphs g<-rgraph(15,3) #Get mutuality and reciprocity scores mutuality(g) grecip(g) #Compare with mutuality } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/lab.optimize.Rd0000644000176200001440000003002711361526037014500 0ustar liggesusers\name{lab.optimize} \alias{lab.optimize} \alias{lab.optimize.anneal} \alias{lab.optimize.exhaustive} \alias{lab.optimize.gumbel} \alias{lab.optimize.hillclimb} \alias{lab.optimize.mc} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Optimize a Bivariate Graph Statistic Across a Set of Accessible Permutations} \description{ \code{lab.optimize} is the front-end to a series of heuristic optimization routines (see below), all of which seek to maximize/minimize some bivariate graph statistic (e.g., graph correlation) across a set of vertex relabelings. } \usage{ lab.optimize(d1, d2, FUN, exchange.list=0, seek="min", opt.method=c("anneal", "exhaustive", "mc", "hillclimb", "gumbel"), ...) lab.optimize.anneal(d1, d2, FUN, exchange.list=0, seek="min", prob.init=1, prob.decay=0.99, freeze.time=1000, full.neighborhood=TRUE, ...) lab.optimize.exhaustive(d1, d2, FUN, exchange.list=0, seek="min", ...) lab.optimize.gumbel(d1, d2, FUN, exchange.list=0, seek="min", draws=500, tol=1e-5, estimator="median", ...) lab.optimize.hillclimb(d1, d2, FUN, exchange.list=0, seek="min", ...) lab.optimize.mc(d1, d2, FUN, exchange.list=0, seek="min", draws=1000, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{d1}{ a single graph. } \item{d2}{ another single graph. } \item{FUN}{ a function taking two graphs as its first two arguments, and returning a numeric value. } \item{exchange.list}{ information on which vertices are exchangeable (see below); this must be a single number, a vector of length n, or a nx2 matrix. } \item{seek}{ "min" if the optimizer should seek a minimum, or "max" if a maximum should be sought. } \item{opt.method}{ the particular optimization method to use. } \item{prob.init}{initial acceptance probability for a downhill move (\code{lab.optimize.anneal} only).} \item{prob.decay}{the decay (cooling) multiplier for the probability of accepting a downhill move (\code{lab.optimize.anneal} only).} \item{freeze.time}{number of iterations at which the annealer should be frozen (\code{lab.optimize.anneal} only).} \item{full.neighborhood}{should all moves in the binary-exchange neighborhood be evaluated at each iteration? (\code{lab.optimize.anneal} only).} \item{tol}{tolerance for estimation of gumbel distribution parameters (\code{lab.optimize.gumbel} only).} \item{estimator}{Gumbel distribution statistic to use as optimal value prediction; must be one of ``mean'', ``median'', or ``mode'' (\code{lab.optimize.gumbel} only).} \item{draws}{number of draws to take for gumbel and mc methods. } \item{\dots}{ additional arguments to \code{FUN}. } } \details{ \code{lab.optimize} is the front-end to a family of routines for optimizing a bivariate graph statistic over a set of permissible relabelings (or equivalently, permutations). The accessible permutation set is determined by the \code{exchange.list} argument, which is dealt with in the following manner. First, \code{exchange.list} is expanded to fill an nx2 matrix. If \code{exchange.list} is a single number, this is trivially accomplished by replication; if \code{exchange.list} is a vector of length n, the matrix is formed by cbinding two copies together. If \code{exchange.list} is already an nx2 matrix, it is left as-is. Once the nx2 exchangeabiliy matrix has been formed, it is interpreted as follows: columns refer to graphs 1 and 2, respectively; rows refer to their corresponding vertices in the original adjacency matrices; and vertices are taken to be theoretically exchangeable iff their corresponding exchangeability matrix values are identical. To obtain an unlabeled graph statistic (the default), then, one could simply let \code{exchange.list} equal any single number. To obtain the labeled statistic, one would use the vector \code{1:n}. Assuming a non-degenerate set of accessible permutations/relabelings, optimization proceeds via the algorithm specified in \code{opt.method}. The optimization routines which are currently implemented use a variety of different techniques, each with certain advantages and disadvantages. A brief summary of each is as follows: \enumerate{ \item exhaustive search (``exhaustive''): Under exhaustive search, the entire space of accessible permutations is combed for the global optimum. This guarantees a correct answer, but at a very high price: the set of all permutations grows with the factorial of the number of vertices, and even substantial exchangeability constraints are unlikely to keep the number of permutations from growing out of control. While exhaustive search \emph{is} possible for small graphs, unlabeled structures of size approximately 10 or greater cannot be treated using this algorithm within a reasonable time frame. Approximate complexity: on the order of \eqn{\prod_{i \in L}|V_i|!}{prod( |V_i|!, i in L )}, where L is the set of exchangeability classes. \item hill climbing (``hillclimb''): The hill climbing algorithm employed here searches, at each iteration, the set of all permissible binary exchanges of vertices. If one or more exchanges are found which are superior to the current permutation, the best alternative is taken. If no superior alternative is found, then the algorithm terminates. As one would expect, this algorithm is guaranteed to terminate on a local optimum; unfortunately, however, it is quite prone to becoming ``stuck'' in suboptimal solutions. In general, hill climbing is not recommended for permutation search, but the method may prove useful in certain circumstances. Approximate complexity: on the order of \eqn{|V(G)|^2} per iteration, total complexity dependent on the number of iterations. \item simulated annealing (``anneal''): The (fairly simple) annealing procedure here employed proceeds as follows. At each iteration, the set of all permissible binary exchanges (if \code{full.neighborhood==TRUE}) or a random selection from this set is evaluated. If a superior option is identified, the best of these is chosen. If no superior options are found, then the algorithm chooses randomly from the set of alternatives with probability equal to the current temperature, otherwise retaining its prior solution. After each iteration, the current temperature is reduced by a factor equal to \code{prob.decay}; the initial temperature is set by \code{prob.init}. When a number of iterations equal to \code{freeze.time} have been completed, the algorithm ``freezes.'' Once ``frozen,'' the annealer hillclimbs from its present location until no improvement is found, and terminates. At termination, the best permutation identified so far is utilized; this need not be the most recent position (though it sometimes is). Simulated annealing is sometimes called ``noisy hill climbing'' because it uses the introduction of random variation to a hill climbing routine to avoid convergence to local optima; it works well on reasonably correlated search spaces with well-defined solution neighborhoods, and is far more robust than hill climbing algorithms. As a general rule, simulated annealing is recommended here for most graphs up to size approximately 50. At this point, computational complexity begins to become a serious barrier, and alternative methods may be more practical. Approximate complexity: on the order of \eqn{|V(G)|^2}*\code{freeze.time} if \code{full.neighborhood==TRUE}, otherwise complexity scales approximately linearly with \code{freeze.time}. This can be misleading, however, since failing to search the full neighborhood generally requires that \code{freeze.time} be greatly increased.) \item blind monte carlo search (``mc''): Blind monte carlo search, as the name implies, consists of randomly drawing a sample of permutations from the accessible permutation set and selecting the best. Although this not such a bad option when A) a large fraction of points are optimal or nearly optimal and B) the search space is largely uncorrelated, these conditions do not seem to characterize most permutation search problems. Blind monte carlo search is not generally recommended, but it is provided as an option should it be desired (e.g., when it is absolutely necessary to control the number of permutations examined). Approximate complexity: linear in \code{draws}. \item extreme value estimation (``gumbel''): Extreme value estimation attempts to estimate a global optimum via stochastic modeling of the distribution of the graph statistic over the space of accessible permutations. The algorithm currently proceeds as follows. First, a random sample is taken from the accessible permutation set (as with monte carlo search, above). Next, this sample is used to fit an extreme value (gumbel) model; the gumbel distribution is the limiting distribution of the extreme values from samples under a continuous, unbounded distribution, and we use it here as an approximation. Having fit the model, an associated statistic (the mean, median, or mode as determined by \code{estimator}) is then used as an estimator of the global optimum. Obviously, this approach has certain drawbacks. First of all, our use of the gumbel model in particular assumes an unbounded, continuous underlying distribution, which may or may not be approximately true for any given problem. Secondly, the inherent non-robustness of extremal problems makes the fact that our prediction rests on a string of approximations rather worrisome: our idea of the shape of the underlying distribution could be distorted by a bad sample, our parameter estimation could be somewhat off, etc., any of which could have serious consequences for our extremal prediction. Finally, the prediction which is made by the extreme value model is \emph{nonconstructive}, in the sense that \emph{no permutation need have been found by the algorithm which induces the predicted value}. On the bright side, this \emph{could} allow one to estimate the optimum without having to find it directly; on the dark side, this means that the reported optimum could be a numerical chimera. At this time, extreme value estimation should be considered \emph{experimental}, and \emph{is not recommended for use on substantive problems.} \code{lab.optimize.gumbel} is not guaranteed to work properly, or to produce intelligible results; this may eventually change in future revisions, or the routine may be scrapped altogether. Approximate complexity: linear in \code{draws}. } This list of algorithms is itself somewhat unstable: some additional techniques (canonical labeling and genetic algorithms, for instance) may be added, and some existing methods (e.g., extreme value estimation) may be modified or removed. Every attempt will be made to keep the command format as stable as possible for other routines (e.g., \code{\link{gscov}}, \code{\link{structdist}}) which depend on \code{lab.optimize} to do their heavy-lifting. In general, it is not expected that the end-user will call \code{lab.optimize} directly; instead, most end-user interaction with these routines will be via the structural distance/covariance functions which used them. } \value{ The estimated global optimum of \code{FUN} over the set of relabelings permitted by \code{exchange.list} } \references{ Butts, C.T. and Carley, K.M. (2005). \dQuote{Some Simple Algorithms for Structural Comparison.} \emph{Computational and Mathematical Organization Theory,} 11(4), 291-305. Butts, C.T., and Carley, K.M. (2001). \dQuote{Multivariate Methods for Interstructural Analysis.} CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{gscov}}, \code{\link{gscor}}, \code{\link{structdist}}, \code{\link{sdmat}} } \examples{ #Generate a random graph and copy it g<-rgraph(10) g2<-rmperm(g) #Permute the copy randomly #Seek the maximum correlation lab.optimize(g,g2,gcor,seek="max",opt.method="anneal",freeze.time=50, prob.decay=0.9) #These two don't do so well... lab.optimize(g,g2,gcor,seek="max",opt.method="hillclimb") lab.optimize(g,g2,gcor,seek="max",opt.method="mc",draws=1000) } \keyword{ optimize }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/is.connected.Rd0000644000176200001440000000327210501711235014450 0ustar liggesusers\name{is.connected} \alias{is.connected} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Is a Given Graph Connected? } \description{ Returns \code{TRUE} iff the specified graphs are connected. } \usage{ is.connected(g, connected = "strong", comp.dist.precomp = NULL) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{g}{ one or more input graphs. } \item{connected}{ definition of connectedness to use; must be one of \code{"strong"}, \code{"weak"}, \code{"unilateral"}, or \code{"recursive"}. } \item{comp.dist.precomp}{ a \code{\link{component.dist}} object precomputed for the graph to be analyzed (optional). } } \details{ \code{is.connected} determines whether the elements of \code{g} are connected under the definition specified in \code{connected}. (See \code{\link{component.dist}} for details.) Since \code{is.connected} is really just a wrapper for \code{\link{component.dist}}, an object created with the latter can be supplied (via \code{comp.dist.precomp}) to speed computation. } \value{ \code{TRUE} iff \code{g} is connected, otherwise \code{FALSE} } \references{ West, D.B. (1996). \emph{Introduction to Graph Theory.} Upper Saddle River, N.J.: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{component.dist}}, \code{\link{components}} } \examples{ #Generate two graphs: g1<-rgraph(10,tp=0.1) g2<-rgraph(10) #Check for connectedness is.connected(g1) #Probably not is.connected(g2) #Probably so } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ logic }% __ONLY ONE__ keyword per line sna/man/gclust.boxstats.Rd0000644000176200001440000000423710501711235015245 0ustar liggesusers\name{gclust.boxstats} \alias{gclust.boxstats} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plot Statistics Associated with Graph Clusters } \description{ \code{gclust.boxstats} creates side-by-side boxplots of graph statistics based on a hierarchical clustering of networks (cut into \code{k} sets). } \usage{ gclust.boxstats(h, k, meas, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{h}{ an \code{\link{hclust}} object, presumably formed by clustering a set of structural distances. } \item{k}{ the number of groups to evaluate. } \item{meas}{ a vector of length equal to the number of graphs in \code{h}, containing a GLI to be evaluated. } \item{\dots}{ additional parameters to \code{\link{boxplot}}. } } \details{ \code{gclust.boxstats} simply takes the \code{\link{hclust}} object in \code{h}, applies \code{\link{cutree}} to form \code{k} groups, and then uses \code{\link{boxplot}} on the distribution of \code{meas} by group. This can be quite handy for assessing graph clusters. } \value{ None } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Actually, this function will work with any \code{\link{hclust}} object and measure matrix; the data need not originate with social networks. For this reason, the clever may also employ this function in conjunction with \code{\link{sedist}} or \code{\link{equiv.clust}} to plot NLIs against clusters of positions within a graph.} %~Make other sections like WARNING with \section{WARNING }{....} ~ %\section{Requires}{\code{mva}} \seealso{ \code{\link{gclust.centralgraph}}, \code{\link{gdist.plotdiff}}, \code{\link{gdist.plotstats}} } \examples{ #Create some random graphs g<-rgraph(10,20,tprob=c(rbeta(10,15,2),rbeta(10,2,15))) #Find the Hamming distances between them g.h<-hdist(g) #Cluster the graphs via their Hamming distances g.c<-hclust(as.dist(g.h)) #Now display boxplots of density by cluster for a two cluster solution gclust.boxstats(g.c,2,gden(g)) } \keyword{ hplot }%-- one or more ... sna/man/sna-deprecated.Rd0000644000176200001440000000165514236302426014765 0ustar liggesusers\name{sna-deprecated} \alias{sna-deprecated} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Deprecated Functions in sna Package} \description{ These functions are provided for compatibility with older versions of \code{sna} only, and may be defunct as soon as the next release. } %\usage{ %} %- maybe also `usage' for other objects documented here. %\arguments{ %} \details{ The following \code{sna} functions are currently deprecated: None at this time. %\describe{ %\item{None. }{None at this time.} %} The original help pages for these functions can be found at \code{help("oldName-deprecated")}. Please avoid using them, since they will disappear.... } %\value{ %None. %} %\references{} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{Deprecated}} } %\examples{ %} \keyword{ misc }%-- one or more ... sna/man/gplot.loop.Rd0000644000176200001440000000544210501711235014172 0ustar liggesusers\name{gplot.loop} \alias{gplot.loop} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Add Loops to a Plot } \description{ \code{gplot.loop} draws a "loop" at a specified location; this is used to designate self-ties in \code{\link{gplot}}. } \usage{ gplot.loop(x0, y0, length = 0.1, angle = 10, width = 0.01, col = 1, border = 1, lty = 1, offset = 0, edge.steps = 10, radius = 1, arrowhead = TRUE, xctr=0, yctr=0, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x0}{ a vector of x coordinates for points of origin. } \item{y0}{ a vector of y coordinates for points of origin. } \item{length}{ arrowhead length, in current plotting units. } \item{angle}{ arrowhead angle (in degrees). } \item{width}{ width for loop body, in current plotting units (can be a vector). } \item{col}{ loop body color (can be a vector). } \item{border}{ loop border color (can be a vector). } \item{lty}{ loop border line type (can be a vector). } \item{offset}{ offset for origin point (can be a vector). } \item{edge.steps}{ number of steps to use in approximating curves. } \item{radius}{ loop radius (can be a vector). } \item{arrowhead}{ boolean; should arrowheads be used? (Can be a vector.) } \item{xctr}{ x coordinate for the central location away from which loops should be oriented. } \item{yctr}{ y coordinate for the central location away from which loops should be oriented. } \item{\dots}{ additional arguments to \code{\link{polygon}}. } } \details{ \code{gplot.loop} is the companion to \code{\link{gplot.arrow}}; like the latter, plot elements produced by \code{gplot.loop} are drawn using \code{\link{polygon}}, and as such are scaled based on the current plotting device. By default, loops are drawn so as to encompass a circular region of radius \code{radius}, whose center is \code{offset} units from \code{x0,y0} and at maximum distance from \code{xctr,yctr}. This is useful for functions like \code{\link{gplot}}, which need to draw loops incident to vertices of varying radii. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot.arrow}}, \code{\link{gplot}}, \code{\link{polygon}} } \examples{ #Plot a few polygons with loops plot(0,0,type="n",xlim=c(-2,2),ylim=c(-2,2),asp=1) gplot.loop(c(0,0),c(1,-1),col=c(3,2),width=0.05,length=0.4, offset=sqrt(2)/4,angle=20,radius=0.5,edge.steps=50,arrowhead=TRUE) polygon(c(0.25,-0.25,-0.25,0.25,NA,0.25,-0.25,-0.25,0.25), c(1.25,1.25,0.75,0.75,NA,-1.25,-1.25,-0.75,-0.75),col=c(2,3)) } \keyword{ aplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/rperm.Rd0000644000176200001440000000324110501711234013214 0ustar liggesusers\name{rperm} \alias{rperm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Draw a Random Permutation Vector with Exchangeability Constraints } \description{ Draws a random permutation on \code{1:length(exchange.list)} such that no two elements whose corresponding \code{exchange.list} values are different are interchanged. } \usage{ rperm(exchange.list) } %- maybe also `usage' for other objects documented here. \arguments{ \item{exchange.list}{ A vector such that the permutation vector may exchange the ith and jth positions iff \code{exchange.list[i]==exchange.list[j]} } } \details{ \code{rperm} draws random permutation vectors given the constraints of exchangeability described above. Thus, \code{rperm(c(0,0,0,0))} returns a random permutation of four elements in which all exchanges are allowed, while \code{rperm(c(1,1,"a","a")} (or similar) returns a random permutation of four elements in which only the first/second and third/fourth elements may be exchanged. This turns out to be quite useful for searching permutation spaces with exchangeability constraints (e.g., for structural distance estimation). } \value{ A random permutation vector satisfying the given constraints } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{rmperm}} } \examples{ rperm(c(0,0,0,0)) #All elements may be exchanged rperm(c(0,0,0,1)) #Fix the fourth element rperm(c(0,0,1,1)) #Allow \{1,2\} and \{3,4\} to be swapped rperm(c("a",4,"x",2)) #Fix all elements (the identity permutation) } \keyword{ distribution } \keyword{ array }%-- one or more ... sna/man/lower.tri.remove.Rd0000644000176200001440000000221411176545273015330 0ustar liggesusers\name{lower.tri.remove} \alias{lower.tri.remove} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Remove the Lower Triangles of Adjacency Matrices in a Graph Stack } \description{ Returns the input graph set, with the lower triangle entries removed/replaced as indicated. } \usage{ lower.tri.remove(dat, remove.val=NA) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{remove.val}{ the value with which to replace the existing lower triangles. } } \details{ \code{lower.tri.remove} is simply a convenient way to apply \code{g[lower.tri(g)]<-remove.val} to an entire stack of adjacency matrices at once. } \value{ The updated graph set. } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{lower.tri}}, \code{\link{upper.tri.remove}}, \code{\link{diag.remove}} } \examples{ #Generate a random graph stack g<-rgraph(3,5) #Remove the lower triangles g<-lower.tri.remove(g) } \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/plot.sociomatrix.Rd0000644000176200001440000000634713572143470015433 0ustar liggesusers\name{plot.sociomatrix} \alias{plot.sociomatrix} \alias{sociomatrixplot} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plot Matrices Using a Color/Intensity Grid } \description{ Plots a matrix, \code{m}, associating the magnitude of the i,jth cell of \code{m} with the color of the i,jth cell of an \code{nrow(m)} by \code{ncol(m)} grid. } \usage{ \method{plot}{sociomatrix}(x, labels=NULL, drawlab=TRUE, diaglab=TRUE, drawlines=TRUE, xlab=NULL, ylab=NULL, cex.lab=1, font.lab=1, col.lab=1, scale.values=TRUE, cell.col=gray, ...) sociomatrixplot(x, labels=NULL, drawlab=TRUE, diaglab=TRUE, drawlines=TRUE, xlab=NULL, ylab=NULL, cex.lab=1, font.lab=1, col.lab=1, scale.values=TRUE, cell.col=gray, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ an input graph. } \item{labels}{ a list containing the vectors of row and column labels (respectively); defaults to the row/column labels of \code{x} (if specified), or otherwise sequential numerical labels. } \item{drawlab}{ logical; add row/column labels to the plot? } \item{diaglab}{ logical; label the diagonal? } \item{drawlines}{ logical; draw lines to mark cell boundaries? } \item{xlab}{ x axis label. } \item{ylab}{ y axis label. } \item{cex.lab}{ optional expansion factor for labels. } \item{font.lab}{ optional font specification for labels. } \item{col.lab}{ optional color specification for labels. } \item{scale.values}{ logical; should cell values be affinely scaled to the [0,1] interval? (Defaults to \code{TRUE}.) } \item{cell.col}{ function taking a vector of cell values as an argument and returning a corresponding vector of colors; defaults to \code{\link{gray}}. } \item{\dots}{ additional arguments to \code{\link{plot}}. } } \details{ \code{plot.sociomatrix} is particularly valuable for examining large adjacency matrices, whose structure can be non-obvious otherwise. \code{sociomatrixplot} is an alias to \code{plot.sociomatrix}, and may eventually supersede it. The \code{cell.col} argument can be any function that takes input cell values and returns legal colors; while \code{\link{gray}} will produce an error for cell values outside the [0,1] interval, user-specified functions can be employed to get other effects (see examples below). Note that, by default, all input cell values are affinely scaled to the [0,1] interval before colors are computed, so \code{scale.values} must be set to \code{FALSE} to allow access to the raw inputs. } \value{ None } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{plot.blockmodel}} } \examples{ #Plot a small adjacency matrix plot.sociomatrix(rgraph(5)) #Plot a much larger one plot.sociomatrix(rgraph(100), drawlab=FALSE, diaglab=FALSE) #Example involving a signed, valued graph and custom colors mycolfun <- function(z){ #Custom color function ifelse(z<0, rgb(1,0,0,alpha=1-1/(1-z)), ifelse(z>0, rgb(0,0,1,alpha=1-1/(1+z)), rgb(0,0,0,alpha=0))) } sg <- rgraph(25) * matrix(rnorm(25^2),25,25) plot.sociomatrix(sg, scale.values=FALSE, cell.col=mycolfun) #Blue pos/red neg } \keyword{ hplot }%-- one or more ... \keyword{graphs} sna/man/gscov.Rd0000644000176200001440000001577410501711235013227 0ustar liggesusers\name{gscov} \alias{gscov} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Structural Covariance(s) Between Two or More Graphs } \description{ \code{gscov} finds the structural covariance between the adjacency matrices of graphs indicated by \code{g1} and \code{g2} in stack \code{dat} (or possibly \code{dat2}) given exchangeability list \code{exchange.list}. Missing values are permitted. } \usage{ gscov(dat, dat2=NULL, g1=NULL, g2=NULL, diag=FALSE, mode="digraph", method="anneal", reps=1000, prob.init=0.9, prob.decay=0.85, freeze.time=25, full.neighborhood=TRUE, exchange.list=0) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{dat2}{ optionally, a second graph stack. } \item{g1}{ the indices of \code{dat} reflecting the first set of graphs to be compared; by default, all members of \code{dat} are included. } \item{g2}{ the indices or \code{dat} (or \code{dat2}, if applicable) reflecting the second set of graphs to be compared; by default, all members of \code{dat} are included. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. \code{mode} is set to \code{"digraph"} by default.} \item{method}{ method to be used to search the space of accessible permutations; must be one of \code{"none"}, \code{"exhaustive"}, \code{"anneal"}, \code{"hillclimb"}, or \code{"mc"}. } \item{reps}{ number of iterations for Monte Carlo method. } \item{prob.init}{ initial acceptance probability for the annealing routine. } \item{prob.decay}{ cooling multiplier for the annealing routine. } \item{freeze.time}{ freeze time for the annealing routine. } \item{full.neighborhood}{ dhould the annealer evaluate the full neighborhood of pair exchanges at each iteration? } \item{exchange.list}{ information on which vertices are exchangeable (see below); this must be a single number, a vector of length n, or a nx2 matrix. } } \details{ The structural covariance between two graphs G and H is defined as \deqn{scov\left(G,H \left| L_G,L_H\right.\right) = \max_{L_G,L_H} cov(\ell(G),\ell(H))}{% scov(G,H | L_G,L_H) = max_[L_G,L_H] cov(l(G),l(H))} where \eqn{L_G} is the set of accessible permutations/labelings of G, \eqn{\ell(G)}{l(G)} is a permutation/labeling of G, and \eqn{\ell(G) \in L_G}{l(G) in L_G}. The set of accessible permutations on a given graph is determined by the \emph{theoretical exchangeability} of its vertices; in a nutshell, two vertices are considered to be theoretically exchangeable for a given problem if all predictions under the conditioning theory are invariant to a relabeling of the vertices in question (see Butts and Carley (2001) for a more formal exposition). Where no vertices are exchangeable, the structural covariance becomes the simple graph covariance. Where \emph{all} vertices are exchangeable, the structural covariance reflects the covariance between unlabeled graphs; other cases correspond to covariance under partial labeling. The accessible permutation set is determined by the \code{exchange.list} argument, which is dealt with in the following manner. First, \code{exchange.list} is expanded to fill an nx2 matrix. If \code{exchange.list} is a single number, this is trivially accomplished by replication; if \code{exchange.list} is a vector of length n, the matrix is formed by cbinding two copies together. If \code{exchange.list} is already an nx2 matrix, it is left as-is. Once the nx2 exchangeabiliy matrix has been formed, it is interpreted as follows: columns refer to graphs 1 and 2, respectively; rows refer to their corresponding vertices in the original adjacency matrices; and vertices are taken to be theoretically exchangeable iff their corresponding exchangeability matrix values are identical. To obtain an unlabeled graph covariance (the default), then, one could simply let \code{exchange.list} equal any single number. To obtain the standard graph covariance, one would use the vector \code{1:n}. Because the set of accessible permutations is, in general, very large (\eqn{o(n!)}), searching the set for the maximum covariance is a non-trivial affair. Currently supported methods for estimating the structural covariance are hill climbing, simulated annealing, blind monte carlo search, or exhaustive search (it is also possible to turn off searching entirely). Exhaustive search is not recommended for graphs larger than size 8 or so, and even this may take days; still, this is a valid alternative for small graphs. Blind monte carlo search and hill climbing tend to be suboptimal for this problem and are not, in general recommended, but they are available if desired. The preferred (and default) option for permutation search is simulated annealing, which seems to work well on this problem (though some tinkering with the annealing parameters may be needed in order to get optimal performance). See the help for \code{\link{lab.optimize}} for more information regarding these options. Structural covariance matrices are p.s.d., and are p.d. so long as no graph within the set is a linear combination of any other under any accessible permutation. Their eigendecompositions are meaningful and they may be used in linear subspace analyses, so long as the researcher is careful to interpret the results in terms of the appropriate set of accessible labelings. Classical null hypothesis tests should not be employed with structural covariances, and QAP tests are almost never appropriate (save in the uniquely labeled case). See \code{\link{cugtest}} for a more reasonable alternative. } \value{ An estimate of the structural covariance matrix } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS Working Paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Consult Butts and Carley (2001) for advice and examples on theoretical exchangeability. } \section{Warning }{The search process can be \emph{very slow}, particularly for large graphs. In particular, the \emph{exhaustive} method is order factorial, and will take approximately forever for unlabeled graphs of size greater than about 7-9.} \seealso{ \code{\link{gscor}}, \code{\link{gcov}}, \code{\link{gcor}} } \examples{ #Generate two random graphs g.1<-rgraph(5) g.2<-rgraph(5) #Copy one of the graphs and permute it perm<-sample(1:5) g.3<-g.2[perm,perm] #What are the structural covariances between the labeled graphs? gscov(g.1,g.2,exchange.list=1:5) gscov(g.1,g.3,exchange.list=1:5) gscov(g.2,g.3,exchange.list=1:5) #What are the structural covariances between the underlying #unlabeled graphs? gscov(g.1,g.2) gscov(g.1,g.3) gscov(g.2,g.3) } \keyword{ univar } \keyword{ multivariate }%-- one or more ... \keyword{ graphs} sna/man/loadcent.Rd0000644000176200001440000000750711176770755013717 0ustar liggesusers\name{loadcent} \Rdversion{1.1} \alias{loadcent} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute the Load Centrality Scores of Network Positions } \description{ \code{loadcent} takes one or more graphs (\code{dat}) and returns the load centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, load on directed or undirected geodesics will be returned; this function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ loadcent(dat, g = 1, nodes = NULL, gmode = "digraph", diag = FALSE, tmaxdev = FALSE, cmode = "directed", geodist.precomp = NULL, rescale = FALSE, ignore.eval = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{digraph} indicates that edges should be interpreted as directed; \code{graph} indicates that edges are undirected. \code{gmode} is set to \code{digraph} by default. } \item{diag}{ logical; should self-ties be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{tmaxdev}{ logical; return the theoretical maximum absolute deviation from the maximum nodal centrality (instead of the observed centrality scores)? By default, \code{tmaxdev}==\code{FALSE}. } \item{cmode}{ string indicating the type of load centrality being computed (directed or undirected). } \item{geodist.precomp}{ a \code{\link{geodist}} object precomputed for the graph to be analyzed (optional). } \item{rescale}{ logical; if true, centrality scores are rescaled such that they sum to 1. } \item{ignore.eval}{ logical; ignore edge values when computing shortest paths? } } \details{ Goh et al.'s \emph{load centrality} (as reformulated by Brandes (2008)) is a betweenness-like measure defined through a hypothetical flow process. Specifically, it is assumed that each vertex sends a unit of some commodity to each other vertex to which it is connected (without edge or vertex capacity constraints), with routing based on a priority system: given an input of flow \eqn{x} arriving at vertex \eqn{v} with destination \eqn{v'}, \eqn{v} divides \eqn{x} equally among all neigbors of minumum geodesic distance to the target. The total flow passing through a given \eqn{v} via this process is defined as \eqn{v}'s \emph{load}. Load is a potential alternative to betweenness for the analysis of flow structures operating well below their capacity constraints. } \value{ A vector of centrality scores. } \references{ Brandes, U. (2008). \dQuote{On Variants of Shortest-Path Betweenness Centrality and their Generic Computation.} \emph{Social Networks}, 30, 136-145. Goh, K.-I.; Kahng, B.; and Kim, D. (2001). \dQuote{Universal Behavior of Load Distribution in Scale-free Networks.} \emph{Physical Review Letters}, 87(27), 1-4. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{betweenness}} } \examples{ g<-rgraph(10) #Draw a random graph with 10 members loadcent(g) #Compute load scores } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ univar } \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/npostpred.Rd0000644000176200001440000000355310501711235014114 0ustar liggesusers\name{npostpred} \alias{npostpred} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Take Posterior Predictive Draws for Functions of Networks } \description{ \code{npostpred} takes a list or data frame, \code{b}, and applies the function \code{FUN} to each element of \code{b}'s \code{net} member. } \usage{ npostpred(b, FUN, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{b}{ A list or data frame containing posterior network draws; these draws must take the form of a graph stack, and must be the member of \code{b} referenced by "\code{net}" } \item{FUN}{ Function for which posterior predictive is to be estimated } \item{\dots}{ Additional arguments to \code{FUN} } } \details{ Although created to work with \code{\link{bbnam}}, \code{npostpred} is quite generic. The form of the posterior draws will vary with the output of \code{FUN}; since invocation is handled by \code{\link{apply}}, check there if unsure. } \value{ A series of posterior predictive draws } \references{ Gelman, A.; Carlin, J.B.; Stern, H.S.; and Rubin, D.B. (1995). \emph{Bayesian Data Analysis.} London: Chapman and Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}} } \examples{ #Create some random data g<-rgraph(5) g.p<-0.8*g+0.2*(1-g) dat<-rgraph(5,5,tprob=g.p) #Define a network prior pnet<-matrix(ncol=5,nrow=5) pnet[,]<-0.5 #Define em and ep priors pem<-matrix(nrow=5,ncol=2) pem[,1]<-3 pem[,2]<-5 pep<-matrix(nrow=5,ncol=2) pep[,1]<-3 pep[,2]<-5 #Draw from the posterior b<-bbnam(dat,model="actor",nprior=pnet,emprior=pem,epprior=pep, burntime=100,draws=100) #Plot a summary of the posterior predictive of reciprocity hist(npostpred(b,grecip)) } \keyword{ models }%-- one or more ... \keyword{ math } sna/man/coleman.Rd0000644000176200001440000000317711212705253013521 0ustar liggesusers\name{coleman} \Rdversion{1.1} \alias{coleman} \docType{data} \title{ Coleman's High School Friendship Data } \description{ James Coleman (1964) reports research on self-reported friendship ties among 73 boys in a small high school in Illinois over the 1957-1958 academic year. Networks of reported ties for all 73 informants are provided for two time points (fall and spring). } \usage{data(coleman)} \format{ An adjacency array containing two directed, unvalued 73-node networks: \tabular{rlll}{ [1,,] \tab Fall \tab binary matrix \tab Friendship for Fall, 1957\cr [2,,] \tab Spring \tab binary matrix \tab Friendship for Spring, 1958\cr } } \details{ Both networks reflect answers to the question, \dQuote{What fellows here in school do you go around with most often?} with the presence of an \eqn{(i,j,k)} edge indicating that \eqn{j} nominated \eqn{k} in time period \eqn{i}. The data are unvalued and directed; although the self-reported ties are highly reciprocal, unreciprocated nominations are possible. It should be noted that, although this data is usually described as \dQuote{friendship,} the sociometric item employed might be more accurately characterized as eliciting \dQuote{frequent elective interaction.} This should be borne in mind when interpreting this data. } %\source{ %% ~~ reference to a publication or URL from which the data were obtained ~~ %} \references{ Coleman, J. S. (1964). \emph{Introduction to Mathermatical Sociology.} New York: Free Press. } \examples{ data(coleman) #Plot showing edges by time point gplot(coleman[1,,]|coleman[2,,],edge.col=2*coleman[1,,]+3*coleman[2,,]) } \keyword{datasets} sna/man/print.netlogit.Rd0000644000176200001440000000133111176542114015055 0ustar liggesusers\name{print.netlogit} \alias{print.netlogit} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for netlogit Objects } \description{ Prints a quick summary of objects produced by \code{\link{netlogit}}. } \usage{ \method{print}{netlogit}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{netlogit} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{netlogit}} } %\examples{ %} \keyword{ print }%-- one or more ... sna/man/kcores.Rd0000644000176200001440000000722013573636526013404 0ustar liggesusers\name{kcores} \Rdversion{1.1} \alias{kcores} \alias{kcores_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute the k-Core Structure of a Graph } \description{ \code{kcores} calculates the k-core structure of the input network, using the centrality measure indicated in \code{cmode}. } \usage{ kcores(dat, mode = "digraph", diag = FALSE, cmode = "freeman", ignore.eval = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more (possibly valued) graphs. } \item{mode}{ \code{"digraph"} for directed data, otherwise \code{"graph"}. } \item{diag}{ logical; should self-ties be included in the degree calculations? } \item{cmode}{ the \code{\link{degree}} centrality mode to use when constructing the cores. } \item{ignore.eval}{ logical; should edge values be ignored when computing degree? } } \details{ Let \eqn{G=(V,E)} be a graph, and let \eqn{f(v,S,G)} for \eqn{v \in V, S\subseteq V}{v in V, S subseteq V} be a real-valued \emph{vertex property function} (in the language of Batagelj and Zaversnik). Then some set \eqn{H \subseteq V}{V subseteq H} is a \emph{generalized k-core} for \eqn{f} if \eqn{H} is a maximal set such that \eqn{f(v,H,G)\ge k}{f(v,H,G)>=k} for all \eqn{v \in H}{v in H}. Typically, \eqn{f} is chosen to be a degree measure with respect to \eqn{S} (e.g., the number of ties to vertices in \eqn{S}). In this case, the resulting k-cores have the intuitive property of being maximal sets such that every set member is tied (in the appropriate manner) to at least k others within the set. Degree-based k-cores are a simple tool for identifying well-connected structures within large graphs. Let the \emph{core number} of vertex \eqn{v} be the value of the highest-value core containing \eqn{v}. Then, intuitively, vertices with high core numbers belong to relatively well-connected sets (in the sense of sets with high minimum internal degree). It is important to note that, while a given k-core need not be connected, it is composed of subsets which are themselves well-connected; thus, the k-cores can be thought of as unions of relatively cohesive subgroups. As k-cores are nested, it is also natural to think of each k-core as representing a \dQuote{slice} through a hypothetical \dQuote{cohesion surface} on \eqn{G}. (Indeed, k-cores are often visualized in exactly this manner.) The \code{kcores} function produces degree-based k-cores, for various degree measures (with or without edge values). The return value is the vector of core numbers for \eqn{V}, based on the selected degree measure. Missing (i.e., \code{NA}) edge are removed for purposes of the degree calculation. } \value{ A vector containing the maximum core membership for each vertex. } \references{ Batagelj, V. and Zaversnik, M. (2002). \dQuote{An \eqn{O(m)} Algorithm for Cores Decomposition of Networks.} arXiv:cs/0310049v1 Batagelj, V. and Zaversnik, M. (2002). \dQuote{Generalized Cores.} arXiv:cs/0202039v1 Wasserman, S. and Faust,K. (1994). \emph{Social Network Analysis: Methods and Applications}. Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{degree}} } \examples{ #Generate a graph with core-periphery structure cv<-runif(30) g<-rgraph(30,tp=cv\%o\%cv) #Compute the k-cores based on total degree kc<-kcores(g) kc #Plot the result gplot(g,vertex.col=kc) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line \keyword{ cluster } sna/man/gplot3d.loop.Rd0000644000176200001440000000302011361530245014414 0ustar liggesusers\name{gplot3d.loop} \alias{gplot3d.loop} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Add Loops to a Three-Dimensional Plot } \description{ \code{gplot3d.loop} draws a "loop" at a specified location; this is used to designate self-ties in \code{\link{gplot3d}}. } \usage{ gplot3d.loop(a, radius, color = "white", alpha = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{a}{ a vector or three-column matrix containing origin X,Y,Z coordinates. } \item{radius}{ the loop radius, in current plotting units. May be a vector, if multiple loops are to be drawn. } \item{color }{ the loop color. May be a vector, if multiple loops are being drawn. } \item{alpha}{ alpha (transparency) value(s) for loops. (May be a vector.) } } \details{ \code{gplot3d.loop} is the companion to \code{\link{gplot3d.arrow}}. The "loops" produced by this routine currently look less like loops than like "hats" -- they are noticable as spike-like structures which protrude from vertices. Eventually, something more attractice will be produced by this routine. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot3d.arrow}}, \code{\link{gplot3d}}, \code{\link[rgl]{rgl-package}} } %\examples{ %} \keyword{ aplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/components.Rd0000644000176200001440000000313410501711235014256 0ustar liggesusers\name{components} \alias{components} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Number of (Maximal) Components Within a Given Graph } \description{ Returns the number of components within \code{dat}, using the connectedness rule given in \code{connected}. } \usage{ components(dat, connected="strong", comp.dist.precomp=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{connected}{ the the component definition to be used by \code{\link{component.dist}} during component extraction. } \item{comp.dist.precomp}{ a component size distribution object from \code{\link{component.dist}} (optional). } } \details{ The \code{connected} parameter corresponds to the \code{rule} parameter of \code{\link{component.dist}}. By default, \code{components} returns the number of strong components, but other component types can be returned if so desired. (See \code{\link{component.dist}} for details.) For symmetric matrices, this is obviously a moot point. } \value{ A vector containing the number of components for each graph in \code{dat} } \references{ West, D.B. (1996). \emph{Introduction to Graph Theory}. Upper Saddle River, NJ: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{component.dist}}, \code{\link{symmetrize}} } \examples{ g<-rgraph(20,tprob=0.05) #Generate a sparse random graph #Find weak components components(g,connected="weak") #Find strong components components(g,connected="strong") } \keyword{ math }%-- one or more ... \keyword{ graphs } sna/man/print.summary.netlm.Rd0000644000176200001440000000134211176541722016051 0ustar liggesusers\name{print.summary.netlm} \alias{print.summary.netlm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.netlm Objects } \description{ Prints an object of class \code{summary.netlm}. } \usage{ \method{print}{summary.netlm}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.netlm} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.netlm}} } %\examples{ % %} \keyword{ print }%-- one or more ... sna/man/gplot3d.arrow.Rd0000644000176200001440000000272014363672354014620 0ustar liggesusers\name{gplot3d.arrow} \alias{gplot3d.arrow} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Add Arrows a Three-Dimensional Plot } \description{ \code{gplot3d.arrow} draws an arrow between two pairs of points. } \usage{ gplot3d.arrow(a, b, radius, color = "white", alpha = 1) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{a}{ a vector or three-column matrix containing origin X,Y,Z coordinates. } \item{b}{ a vector or three-column matrix containing origin X,Y,Z coordinates. } \item{radius}{ the arrow radius, in current plotting units. May be a vector, if multiple arrows are to be drawn. } \item{color }{ the arrow color. May be a vector, if multiple arrows are being drawn. } \item{alpha}{ alpha (transparency) value(s) for arrows. (May be a vector.) } } \details{ \code{gplot3d.arrow} draws one or more three-dimensional \dQuote{arrows} from the points given in \code{a} to those given in \code{b}. Note that the \dQuote{arrows} are really cones, narrowing in the direction of the destination point. } \value{ None. } %\references{ ~put references to the literature/web site here ~ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot3d}}, \code{\link{gplot3d.loop}} } %\examples{ %} \keyword{ aplot }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/bn.Rd0000644000176200001440000001313513573635062012511 0ustar liggesusers\name{bn} \alias{bn} \alias{coef.bn} \alias{bn.nlpl.dyad} \alias{bn.nlpl.edge} \alias{bn.nlpl.triad} \alias{bn.nltl} \alias{plot.bn} \alias{print.bn} \alias{print.summary.bn} \alias{summary.bn} \alias{bn_dyadstats_R} \alias{bn_lpl_dyad_R} \alias{bn_lpl_triad_R} \alias{bn_ptriad_R} \alias{bn_triadstats_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Fit a Biased Net Model } \description{ Fits a biased net model to an input graph, using moment-based or maximum pseudolikelihood techniques. } \usage{ bn(dat, method = c("mple.triad", "mple.dyad", "mple.edge", "mtle"), param.seed = NULL, param.fixed = NULL, optim.method = "BFGS", optim.control = list(), epsilon = 1e-05) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ a single input graph. } \item{method}{ the fit method to use (see below). } \item{param.seed}{ seed values for the parameter estimates. } \item{param.fixed}{ parameter values to fix, if any. } \item{optim.method}{ method to be used by \code{\link{optim}}. } \item{optim.control}{ control parameter for \code{\link{optim}}. } \item{epsilon}{ tolerance for convergence to extreme parameter values (i.e., 0 or 1). } } \details{ The biased net model stems from early work by Rapoport, who attempted to model networks via a hypothetical "tracing" process. This process may be described loosely as follows. One begins with a small "seed" set of vertices, each member of which is assumed to nominate (generate ties to) other members of the population with some fixed probability. These members, in turn, may nominate new members of the population, as well as members who have already been reached. Such nominations may be "biased" in one fashion or another, leading to a non-uniform growth process. Specifically, let \eqn{e_{ij}}{e_ij} be the random event that vertex \eqn{i} nominates vertex \eqn{j} when reached. Then the conditional probability of \eqn{e_{ij}}{e_ij} is given by \deqn{ \Pr(e_{ij}|T) = 1-\left(1-\Pr(B_e)\right) \prod_k \left(1-\Pr(B_k|T)\right) }{% Pr(e_ij | T) = 1 - (1-Pr(B_e)) prod_k (1 - Pr(B_k | T)) } where \eqn{T} is the current state of the trace, \eqn{B_e} is the a Bernoulli event corresponding to the baseline probability of \eqn{e_{ij}}{e_ij}, and the \eqn{B_k} are "bias events." Bias events are taken to be independent Bernoulli trials, given \eqn{T}, such that \eqn{e_{ij}}{e_ij} is observed with certainty if any bias event occurs. The specification of a biased net model, then, involves defining the various bias events (which, in turn, influence the structure of the network). Although other events have been proposed, the primary bias events employed in current biased net models are the "parent bias" (a tendency to return nominations); the "sibling bias" (a tendency to nominate alters who were nominated by the same third party); and the "double role bias" (a tendency to nominate alters who are both siblings and parents). These bias events, together with the baseline edge events, are used to form the standard biased net model. It is standard to assume homogeneity within bias class, leading to the four parameters \eqn{\pi}{pi} (probability of a parent bias event), \eqn{\sigma}{sigma} (probability of a sibling bias event), \eqn{\rho}{rho} (probability of a double role bias event), and \eqn{d} (probability of a baseline event). Unfortunately, there is no simple expression for the likelihood of a graph given these parameters (and hence, no basis for likelihood based inference). However, Skvoretz et al. have derived a class of maximum pseudo-likelihood estimators for the the biased net model, based on local approximations to the likelihood at the edge, dyad, or triad level. These estimators may be employed within \code{bn} by selecting the appropriate MPLE for the \emph{method} argument. Alternately, it is also possible to derive expected triad census rates for the biased net model, allowing an estimator which maximizes the likelihood of the observed triad census (essentially, a method of moments procedure). This last may be selected via the argument \code{mode="mtle"}. In addition to estimating model parameters, \code{bn} generates predicted edge, dyad, and triad census statistics, as well as structure statistics (using the Fararo-Sunshine recurrence). These can be used to evaluate goodness-of-fit. \code{print}, \code{summary}, and \code{plot} methods are available for \code{bn} objects. See \code{\link{rgbn}} for simulation from biased net models. } \value{ An object of class \code{bn}. } \references{ Fararo, T.J. and Sunshine, M.H. (1964). ``A study of a biased friendship net.'' Syracuse, NY: Youth Development Center. Rapoport, A. (1957). ``A contribution to the theory of random and biased nets.'' \emph{Bulletin of Mathematical Biophysics,} 15, 523-533. Skvoretz, J.; Fararo, T.J.; and Agneessens, F. (2004). ``Advances in biased net theory: definitions, derivations, and estimations.'' \emph{Social Networks,} 26, 113-139. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ Asymptotic properties of the MPLE are not known for this model. Caution is strongly advised. } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{rgbn}}, \code{\link{structure.statistics}} } \examples{ #Generate a random graph g<-rgraph(25) #Fit a biased net model, using the triadic MPLE gbn<-bn(g) #Examine the results summary(gbn) plot(gbn) #Now, fit a model containing only a density parameter gbn<-bn(g,param.fixed=list(pi=0,sigma=0,rho=0)) summary(gbn) plot(gbn) } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ models }% __ONLY ONE__ keyword per line sna/man/netcancor.Rd0000644000176200001440000001336510501711234014053 0ustar liggesusers\name{netcancor} \alias{netcancor} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Canonical Correlation for Labeled Graphs } \description{ \code{netcancor} finds the canonical correlation(s) between the graph sets \code{x} and \code{y}, testing the result using either conditional uniform graph (CUG) or quadratic assignment procedure (QAP) null hypotheses. } \usage{ netcancor(y, x, mode="digraph", diag=FALSE, nullhyp="cugtie", reps=1000) } %- maybe also `usage' for other objects documented here. \arguments{ \item{y}{ one or more input graphs. } \item{x}{ one or more input graphs. } \item{mode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{nullhyp}{ string indicating the particular null hypothesis against which to test the observed estimands. A value of "cug" implies a conditional uniform graph test (see \code{\link{cugtest}}) controlling for order \emph{only}; "cugden" controls for both order and tie probability; "cugtie" controls for order and tie distribution (via bootstrap); and "qap" implies that the QAP null hypothesis (see \code{\link{qaptest}}) should be used. } \item{reps}{integer indicating the number of draws to use for quantile estimation. (Relevant to the null hypothesis test only - the analysis itself is unaffected by this parameter.) Note that, as for all Monte Carlo procedures, convergence is slower for more extreme quantiles. } } \details{ The \code{netcancor} routine is actually a front-end to the \code{\link{cancor}} routine for computing canonical correlations between sets of vectors. \code{netcancor} itself vectorizes the network variables (as per its graph type) and manages the appropriate null hypothesis tests; the actual canonical correlation is handled by \code{\link{cancor}}. Canonical correlation itself is a multivariate generalization of the product-moment correlation. Specifically, the analysis seeks linear combinations of the variables in \code{y} which are well-explained by linear combinations of the variables in \code{x}. The network version of this technique is performed elementwise on the adjacency matrices of the graphs in question; as usual, the result should be interpreted with an eye to the relationship between the type of data used and the assumptions of the underlying model. Intelligent printing and summarizing of netcancor objects is provided by \code{\link{print.netcancor}} and \code{\link{summary.netcancor}}. } \value{ An object of class \code{netcancor} with the following properties: \item{xdist}{ Array containing the distribution of the X coefficients under the null hypothesis test. } \item{ydist}{ Array containing the distribution of the Y coefficients under the null hypothesis test. } \item{cdist}{ Array containing the distribution of the canonical correlation coefficients under the null hypothesis test. } \item{cor}{ Vector containing the observed canonical correlation coefficients. } \item{xcoef}{ Vector containing the observed X coefficients. } \item{ycoef}{ Vector containing the observed Y coefficients. } \item{cpgreq}{ Vector containing the estimated upper tail quantiles (p>=obs) for the observed canonical correlation coefficients under the null hypothesis. } \item{cpleeq}{ Vector containing the estimated lower tail quantiles (p<=obs) for the observed canonical correlation coefficients under the null hypothesis. } \item{xpgreq}{ Matrix containing the estimated upper tail quantiles (p>=obs) for the observed X coefficients under the null hypothesis. } \item{xpleeq}{ Matrix containing the estimated lower tail quantiles (p<=obs) for the observed X coefficients under the null hypothesis. } \item{ypgreq}{ Matrix containing the estimated upper tail quantiles (p>=obs) for the observed Y coefficients under the null hypothesis. } \item{ypleeq}{ Matrix containing the estimated lower tail quantiles (p<=obs) for the observed Y coefficients under the null hypothesis. } \item{cnames}{ Vector containing names for the canonical correlation coefficients. } \item{xnames}{ Vector containing names for the X vars. } \item{ynames}{ Vector containing names for the Y vars. } \item{xcenter}{ Values used to adjust the X variables. } \item{xcenter}{ Values used to adjust the Y variables. } \item{nullhyp}{ String indicating the null hypothesis employed. } } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ This will eventually be replaced with a superior cancor procedure with more interpretable output; the new version will handle arbitrary labeling as well. } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\section{Requires }{\code{mva}} \seealso{ \code{\link{gcor}}, \code{\link{cugtest}}, \code{\link{qaptest}}, \code{\link{cancor}} } \examples{ #Generate a valued seed structure cv<-matrix(rnorm(100),nrow=10,ncol=10) #Produce two sets of valued graphs x<-array(dim=c(3,10,10)) x[1,,]<-3*cv+matrix(rnorm(100,0,0.1),nrow=10,ncol=10) x[2,,]<--1*cv+matrix(rnorm(100,0,0.1),nrow=10,ncol=10) x[3,,]<-x[1,,]+2*x[2,,]+5*cv+matrix(rnorm(100,0,0.1),nrow=10,ncol=10) y<-array(dim=c(2,10,10)) y[1,,]<--5*cv+matrix(rnorm(100,0,0.1),nrow=10,ncol=10) y[2,,]<--2*cv+matrix(rnorm(100,0,0.1),nrow=10,ncol=10) #Perform a canonical correlation analysis nc<-netcancor(y,x,reps=100) summary(nc) } \keyword{ multivariate }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/bonpow.Rd0000644000176200001440000001376510501711235013410 0ustar liggesusers\name{bonpow} \alias{bonpow} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find Bonacich Power Centrality Scores of Network Positions } \description{ \code{bonpow} takes one or more graphs (\code{dat}) and returns the Boncich power centralities of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. The decay rate for power contributions is specified by \code{exponent} (1 by default). This function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ bonpow(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, tmaxdev=FALSE, exponent=1, rescale=FALSE, tol=1e-07) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g}=1. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected. This is currently ignored. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{Diag} is \code{FALSE} by default. } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev}=\code{FALSE}. } \item{exponent}{ exponent (decay rate) for the Bonacich power centrality score; can be negative } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{tol}{ tolerance for near-singularities during matrix inversion (see \code{\link{solve}}) } } \details{ Bonacich's power centrality measure is defined by \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha\left(\mathbf{I}-\beta\mathbf{A}\right)^{-1}\mathbf{A}\mathbf{1}}{C_BP(alpha,beta)=alpha (I-A)^-1 A 1}, where \eqn{\beta}{beta} is an attenuation parameter (set here by \code{exponent}) and \eqn{\mathbf{A}}{A} is the graph adjacency matrix. (The coefficient \eqn{\alpha}{alpha} acts as a scaling parameter, and is set here (following Bonacich (1987)) such that the sum of squared scores is equal to the number of vertices. This allows 1 to be used as a reference value for the ``middle'' of the centrality range.) When \eqn{\beta \rightarrow 1/\lambda_{\mathbf{A}1}}{beta->1/lambda_A1} (the reciprocal of the largest eigenvalue of \eqn{\mathbf{A}}{A}), this is to within a constant multiple of the familiar eigenvector centrality score; for other values of \eqn{\beta}, the behavior of the measure is quite different. In particular, \eqn{\beta} gives positive and negative weight to even and odd walks, respectively, as can be seen from the series expansion \eqn{C_{BP}\left(\alpha,\beta\right)=\alpha \sum_{k=0}^\infty \beta^k \mathbf{A}^{k+1} \mathbf{1}}{C_BP(alpha,beta) = alpha sum( beta^k A^(k+1) 1, k in 0..infinity )} which converges so long as \eqn{|\beta| < 1/\lambda_{\mathbf{A}1}}{|beta|<1/lambda_A1}. The magnitude of \eqn{\beta}{beta} controls the influence of distant actors on ego's centrality score, with larger magnitudes indicating slower rates of decay. (High rates, hence, imply a greater sensitivity to edge effects.) Interpretively, the Bonacich power measure corresponds to the notion that the power of a vertex is recursively defined by the sum of the power of its alters. The nature of the recursion involved is then controlled by the power exponent: positive values imply that vertices become more powerful as their alters become more powerful (as occurs in cooperative relations), while negative values imply that vertices become more powerful only as their alters become \emph{weaker} (as occurs in competitive or antagonistic relations). The magnitude of the exponent indicates the tendency of the effect to decay across long walks; higher magnitudes imply slower decay. One interesting feature of this measure is its relative instability to changes in exponent magnitude (particularly in the negative case). If your theory motivates use of this measure, you should be very careful to choose a decay parameter on a non-ad hoc basis. } \value{ A vector, matrix, or list containing the centrality scores (depending on the number and size of the input graphs). } \references{ Bonacich, P. (1972). ``Factoring and Weighting Approaches to Status Scores and Clique Identification.'' \emph{Journal of Mathematical Sociology}, 2, 113-120. Bonacich, P. (1987). ``Power and Centrality: A Family of Measures.'' \emph{American Journal of Sociology}, 92, 1170-1182. } \author{ Carter T. Butts \email{buttsc@uci.edu}} \note{ The theoretical maximum deviation used here is not obtained with the star network, in general. For positive exponents, at least, the symmetric maximum occurs for an empty graph with one complete dyad (the asymmetric maximum is generated by the outstar). UCINET V seems not to adjust for this fact, which can cause some oddities in their centralization scores (thus, don't expect to get the same numbers with both packages).} \section{Warning }{Singular adjacency matrices cause no end of headaches for this algorithm; thus, the routine may fail in certain cases. This will be fixed when I get a better algorithm. \code{bonpow} will not symmetrize your data before extracting eigenvectors; don't send this routine asymmetric matrices unless you really mean to do so.} \seealso{ \code{\link{centralization}}, \code{\link{evcent}} } \examples{ #Generate some test data dat<-rgraph(10,mode="graph") #Compute Bonpow scores bonpow(dat,exponent=1,tol=1e-20) bonpow(dat,exponent=-1,tol=1e-20) } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{ graphs} sna/man/bbnam.Rd0000644000176200001440000003241311212705324013154 0ustar liggesusers\name{bbnam} \alias{bbnam} \alias{bbnam.actor} \alias{bbnam.pooled} \alias{bbnam.fixed} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Butts' (Hierarchical) Bayesian Network Accuracy Model } \description{ Takes posterior draws from Butts' bayesian network accuracy/estimation model for multiple participant/observers (conditional on observed data and priors), using a Gibbs sampler. } \usage{ bbnam(dat, model="actor", ...) bbnam.fixed(dat, nprior=0.5, em=0.25, ep=0.25, diag=FALSE, mode="digraph", draws=1500, outmode="draws", anames=NULL, onames=NULL) bbnam.pooled(dat, nprior=0.5, emprior=c(1,11), epprior=c(1,11), diag=FALSE, mode="digraph", reps=5, draws=1500, burntime=500, quiet=TRUE, anames=NULL, onames=NULL, compute.sqrtrhat=TRUE) bbnam.actor(dat, nprior=0.5, emprior=c(1,11), epprior=c(1,11), diag=FALSE, mode="digraph", reps=5, draws=1500, burntime=500, quiet=TRUE, anames=NULL, onames=NULL, compute.sqrtrhat=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ Input networks to be analyzed. This may be supplied in any reasonable form, but must be reducible to an array of dimension \eqn{m \times n \times n}{m x n x n}, where \eqn{n} is \eqn{|V(G)|}, the first dimension indexes the observer (or information source), the second indexes the sender of the relation, and the third dimension indexes the recipient of the relation. (E.g., \code{dat[i,j,k]==1} implies that i observed j sending the relation in question to k.) Note that only dichotomous data is supported at present, and missing values are permitted; the data collection pattern, however, is assumed to be ignorable, and hence the posterior draws are implicitly conditional on the observation pattern. } \item{model}{ String containing the error model to use; options are \code{"actor"}, \code{"pooled"}, and \code{"fixed"}. } \item{...}{Arguments to be passed by \code{bbnam} to the particular model method.} \item{nprior}{ Network prior matrix. This must be a matrix of dimension \eqn{n} x \eqn{n}, containing the arc/edge priors for the criterion network. (E.g., \code{nprior[i,j]} gives the prior probability of \code{i} sending the relation to \code{j} in the criterion graph.) Non-matrix values will be coerced/expanded to matrix form as appropriate. If no network prior is provided, an uninformative prior on the space of networks will be assumed (i.e., \eqn{\Pr(i\to j)=0.5}{Pr(i->j)=0.5}). Missing values are not allowed. } \item{em}{ Probability of a false negative; this may be in the form of a single number, one number per observation slice, one number per (directed) dyad, or one number per dyadic observation (fixed model only). } \item{ep}{ Probability of a false positive; this may be in the form of a single number, one number per observation slice, one number per (directed) dyad, or one number per dyadic observation (fixed model only). } \item{emprior}{ Parameters for the (Beta) false negative prior; these should be in the form of an \eqn{(\alpha,\beta)}{(alpha,beta)} pair for the pooled model, and of an \eqn{n \times 2}{n x 2} matrix of \eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the actor model (or something which can be coerced to this form). If no \code{emprior} is given, a weakly informative prior (1,11) will be assumed; note that this may be inappropriate, as described below. Missing values are not allowed. } \item{epprior}{ Parameters for the (Beta) false positive prior; these should be in the form of an \eqn{(\alpha,\beta)}{(alpha,beta)} pair for the pooled model, and of an \eqn{n \times 2}{n x 2} matrix of \eqn{(\alpha,\beta)}{(alpha,beta)} pairs for the actor model (or something which can be coerced to this form). If no \code{epprior} is given, a weakly informative prior (1,11) will be assumed; note that this may be inappropriate, as described below. Missing values are not allowed. } \item{diag}{ Boolean indicating whether loops (matrix diagonals) should be counted as data. } \item{mode}{ A string indicating whether the data in question forms a \code{"graph"} or a \code{"digraph"} } \item{reps}{ Number of replicate chains for the Gibbs sampler (pooled and actor models only). } \item{draws}{ Integer indicating the total number of draws to take from the posterior distribution. Draws are taken evenly from each replication (thus, the number of draws from a given chain is draws/reps). } \item{burntime}{ Integer indicating the burn-in time for the Markov Chain. Each replication is iterated burntime times before taking draws (with these initial iterations being discarded); hence, one should realize that each increment to burntime increases execution time by a quantity proportional to reps. (pooled and actor models only) } \item{quiet}{ Boolean indicating whether MCMC diagnostics should be displayed (pooled and actor models only). } \item{outmode}{ \code{posterior} indicates that the exact posterior probability matrix for the criterion graph should be returned; otherwise draws from the joint posterior are returned instead (fixed model only). } \item{anames}{ A vector of names for the actors (vertices) in the graph. } \item{onames}{ A vector of names for the observers (possibly the actors themselves) whose reports are contained in the input data.} \item{compute.sqrtrhat}{ A boolean indicating whether or not Gelman et al.'s potential scale reduction measure (an MCMC convergence diagnostic) should be computed (pooled and actor models only). } } \details{ The bbnam models a set of network data as reflecting a series of (noisy) observations by a set of participants/observers regarding an uncertain criterion structure. Each observer is assumed to send false positives (i.e., reporting a tie when none exists in the criterion structure) with probability \eqn{e^+}{e^+}, and false negatives (i.e., reporting that no tie exists when one does in fact exist in the criterion structure) with probability \eqn{e^-}{e^-}. The criterion network itself is taken to be a Bernoulli (di)graph. Note that the present model includes three variants: \enumerate{ \item Fixed error probabilities: Each edge is associated with a known pair of false negative/false positive error probabilities (provided by the researcher). In this case, the posterior for the criterion graph takes the form of a matrix of Bernoulli parameters, with each edge being independent conditional on the parameter matrix. \item Pooled error probabilities: One pair of (uncertain) false negative/false positive error probabilities is assumed to hold for all observations. Here, we assume that the researcher's prior information regarding these parameters can be expressed as a pair of Beta distributions, with the additional assumption of independence in the prior distribution. Note that error rates and edge probabilities are \emph{not} independent in the joint posterior, but the posterior marginals take the form of Beta mixtures and Bernoulli parameters, respectively. \item Per observer (``actor'') error probabilities: One pair of (uncertain) false negative/false positive error probabilities is assumed to hold for each observation slice. Again, we assume that prior knowledge can be expressed in terms of independent Beta distributions (along with the Bernoulli prior for the criterion graph) and the resulting posterior marginals are Beta mixtures and a Bernoulli graph. (Again, it should be noted that independence in the priors does \emph{not} imply independence in the joint posterior!) } By default, the \code{bbnam} routine returns (approximately) independent draws from the joint posterior distribution, each draw yielding one realization of the criterion network and one collection of accuracy parameters (i.e., probabilities of false positives/negatives). This is accomplished via a Gibbs sampler in the case of the pooled/actor model, and by direct sampling for the fixed probability model. In the special case of the fixed probability model, it is also possible to obtain directly the posterior for the criterion graph (expressed as a matrix of Bernoulli parameters); this can be controlled by the \code{outmode} parameter. As noted, the taking of posterior draws in the nontrivial case is accomplished via a Markov Chain Monte Carlo method, in particular the Gibbs sampler; the high dimensionality of the problem (\eqn{O(n^2+2n)}{O(n^2+2n)}) tends to preclude more direct approaches. At present, chain burn-in is determined ex ante on a more or less arbitrary basis by specification of the \code{burntime} parameter. Eventually, a more systematic approach will be utilized. Note that insufficient burn-in will result in inaccurate posterior sampling, so it's not wise to skimp on burn time where otherwise possible. Similarly, it is wise to employ more than one Markov Chain (set by \code{reps}), since it is possible for trajectories to become \dQuote{trapped} in metastable regions of the state space. Number of draws per chain being equal, more replications are usually better than few; consult Gelman et al. for details. A useful measure of chain convergence, Gelman and Rubin's potential scale reduction (\eqn{\sqrt{\hat{R}}}{\sqrt{\hat{R}}}), can be computed using the \code{compute.sqrtrhat} parameter. The potential scale reduction measure is an ANOVA-like comparison of within-chain versus between-chain variance; it approaches 1 (from above) as the chain converges, and longer burn-in times are strongly recommended for chains with scale reductions in excess of 1.2 or thereabouts. Finally, a cautionary concerning prior distributions: it is important that the specified priors actually reflect the prior knowledge of the researcher; otherwise, the posterior will be inadequately informed. In particular, note that an uninformative prior on the accuracy probabilities implies that it is a priori equally probable that any given actor's observations will be informative or \emph{negatively} informative (i.e., that \eqn{i} observing \eqn{j} sending a tie to \eqn{k} \emph{reduces} \eqn{\Pr(j\to k)}{Pr(j->k)}). This is a highly unrealistic assumption, and it will tend to produce posteriors which are bimodal (one mode being related to the \dQuote{informative} solution, the other to the \dQuote{negatively informative} solution). Currently, the default error parameter prior is Beta(1,11), which is both diffuse and which renders negatively informative observers extremely improbable (i.e., on the order of 1e-6). Another plausible but still fairly diffuse prior would be Beta(3,5), which reduces the prior probability of an actor's being negatively informative to 0.16, and the prior probability of any given actor's being more than 50\% likely to make a particular error (on average) to around 0.22. (This prior also puts substantial mass near the 0.5 point, which would seem consonant with the BKS studies.) For network priors, a reasonable starting point can often be derived by considering the expected mean degree of the criterion graph: if \eqn{d} represents the user's prior expectation for the mean degree, then \eqn{d/(N-1)} is a natural starting point for the cell values of \code{nprior}. Butts (2003) discusses a number of issues related to choice of priors for the \code{bbnam} model, and users should consult this reference if matters are unclear before defaulting to the uninformative solution. } \value{ An object of class bbnam, containing the posterior draws. The components of the output are as follows: \item{anames}{ A vector of actor names. } \item{draws}{ An integer containing the number of draws. } \item{em}{ A matrix containing the posterior draws for probability of producing false negatives, by actor. } \item{ep}{ A matrix containing the posterior draws for probability of producing false positives, by actor. } \item{nactors}{ An integer containing the number of actors. } \item{net}{ An array containing the posterior draws for the criterion network. } \item{reps}{ An integer indicating the number of replicate chains used by the Gibbs sampler. } } \references{ Butts, C. T. (2003). \dQuote{Network Inference, Error, and Informant (In)Accuracy: A Bayesian Approach.} \emph{Social Networks}, 25(2), 103-140. Gelman, A.; Carlin, J.B.; Stern, H.S.; and Rubin, D.B. (1995). \emph{Bayesian Data Analysis.} London: Chapman and Hall. Gelman, A., and Rubin, D.B. (1992). \dQuote{Inference from Iterative Simulation Using Multiple Sequences.} \emph{Statistical Science,} 7, 457-511. Krackhardt, D. (1987). \dQuote{Cognitive Social Structures.} \emph{Social Networks,} 9, 109-134. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ As indicated, the posterior draws are conditional on the observed data, and hence on the data collection mechanism if the collection design is non-ignorable. Complete data (e.g., a CSS) and random tie samples are examples of ignorable designs; see Gelman et al. for more information concerning ignorability.} \seealso{\code{\link{npostpred}}, \code{\link{event2dichot}}, \code{\link{bbnam.bf}}} \examples{ #Create some random data g<-rgraph(5) g.p<-0.8*g+0.2*(1-g) dat<-rgraph(5,5,tprob=g.p) #Define a network prior pnet<-matrix(ncol=5,nrow=5) pnet[,]<-0.5 #Define em and ep priors pem<-matrix(nrow=5,ncol=2) pem[,1]<-3 pem[,2]<-5 pep<-matrix(nrow=5,ncol=2) pep[,1]<-3 pep[,2]<-5 #Draw from the posterior b<-bbnam(dat,model="actor",nprior=pnet,emprior=pem,epprior=pep, burntime=100,draws=100) #Print a summary of the posterior draws summary(b) } \keyword{ models} \keyword{ math } sna/man/connectedness.Rd0000644000176200001440000000516013573637436014753 0ustar liggesusers\name{connectedness} \alias{connectedness} \alias{connectedness_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute Graph Connectedness Scores } \description{ \code{connectedness} takes one or more graphs (\code{dat}) and returns the Krackhardt connectedness scores for the graphs selected by \code{g}. } \usage{ connectedness(dat, g=NULL) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{g}{ index values for the graphs to be utilized; by default, all graphs are selected. } } \details{ Krackhardt's connectedness for a digraph \eqn{G} is equal to the fraction of all dyads, \eqn{\{i,j\}}, such that there exists an undirected path from \eqn{i} to \eqn{j} in \eqn{G}. (This, in turn, is just the density of the weak \code{\link{reachability}} graph of \eqn{G}.) Obviously, the connectedness score ranges from 0 (for the null graph) to 1 (for weakly connected graphs). Connectedness is one of four measures (\code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, and \code{\link{lubness}}) suggested by Krackhardt for summarizing hierarchical structures. Each corresponds to one of four axioms which are necessary and sufficient for the structure in question to be an outtree; thus, the measures will be equal to 1 for a given graph iff that graph is an outtree. Deviations from unity can be interpreted in terms of failure to satisfy one or more of the outtree conditions, information which may be useful in classifying its structural properties. } \value{ A vector containing the connectedness scores } \references{ Krackhardt, David. (1994). ``Graph Theoretical Dimensions of Informal Organizations.'' In K. M. Carley and M. J. Prietula (Eds.), \emph{Computational Organization Theory}, 89-111. Hillsdale, NJ: Lawrence Erlbaum and Associates.} \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The four Krackhardt indices are, in general, nondegenerate for a relatively narrow band of size/density combinations (efficiency being the sole exception). This is primarily due to their dependence on the reachability graph, which tends to become complete rapidly as size/density increase. See Krackhardt (1994) for a useful simulation study. } \seealso{ \code{\link{connectedness}}, \code{\link{efficiency}}, \code{\link{hierarchy}}, \code{\link{lubness}}, \code{\link{reachability}} } \examples{ #Get connectedness scores for graphs of varying densities connectedness(rgraph(10,5,tprob=c(0.1,0.25,0.5,0.75,0.9))) } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ univar }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/upper.tri.remove.Rd0000644000176200001440000000223510501711234015315 0ustar liggesusers\name{upper.tri.remove} \alias{upper.tri.remove} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Remove the Upper Triangles of Adjacency Matrices in a Graph Stack } \description{ Returns the input graph stack, with the upper triangle entries removed/replaced as indicated. } \usage{ upper.tri.remove(dat, remove.val=NA) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ a graph or graph stack. } \item{remove.val}{ the value with which to replace the existing upper triangles. } } \details{ \code{upper.tri.remove} is simply a convenient way to apply \code{g[upper.tri(g)]<-remove.val} to an entire stack of adjacency matrices at once. } \value{ The updated graph stack. } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{} %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{upper.tri}}, \code{\link{lower.tri.remove}}, \code{\link{diag.remove}} } \examples{ #Generate a random graph stack g<-rgraph(3,5) #Remove the upper triangles g<-upper.tri.remove(g) } \keyword{ manip } \keyword{ array }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/gdist.plotdiff.Rd0000644000176200001440000000464610501711235015022 0ustar liggesusers\name{gdist.plotdiff} \alias{gdist.plotdiff} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Plot Differences in Graph-level Statistics Against Inter-graph Distances} \description{ For a given graph set, \code{gdist.plotdiff} plots the distances between graphs against their distances (or differences) on a set of graph-level measures. } \usage{ gdist.plotdiff(d, meas, method="manhattan", jitter=TRUE, xlab="Inter-Graph Distance", ylab="Measure Distance", lm.line=FALSE, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{d}{ A matrix containing the inter-graph distances } \item{meas}{ An n x m matrix containing the graph-level indices; rows of this matrix must correspond to graphs, and columns to indices } \item{method}{ The distance method used by \code{\link{dist}} to establish differences/distances between graph GLI values. By default, absolute ("manhattan") differences are used. } \item{jitter}{ Should values be jittered prior to display? } \item{xlab}{ A label for the X axis } \item{ylab}{ A label for the Y axis } \item{lm.line}{ Include a least-squares line? } \item{\dots}{ Additional arguments to \code{\link{plot}} } } \details{ \code{gdist.plotdiff} works by taking the distances between all graphs on \code{meas} and then plotting these distances against \code{d} for all pairs of graphs (with, optionally, an added least-squares line for reference value). This can be a useful exploratory tool for relating inter-graph distances (e.g., Hamming distances) to differences on other attributes. } \value{ None } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ This function is actually quite generic, and can be used with node-level -- or even non-network -- data as well. } %~Make other sections like WARNING with \section{WARNING }{....} ~ %\section{Requires}{\code{mva}} \seealso{ \code{\link{gdist.plotstats}}, \code{\link{gclust.boxstats}}, \code{\link{gclust.centralgraph}} } \examples{ #Generate some random graphs with varying densities g<-rgraph(10,20,tprob=runif(20,0,1)) #Find the Hamming distances between graphs g.h<-hdist(g) #Plot the relationship between distance and differences in density gdist.plotdiff(g.h,gden(g),lm.line=TRUE) } \keyword{ hplot }%-- one or more ... sna/man/reachability.Rd0000644000176200001440000001004213573636672014554 0ustar liggesusers\name{reachability} \alias{reachability} \alias{reachability_R} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Reachability Matrix of a Graph } \description{ \code{reachability} takes one or more (possibly directed) graphs as input, producing the associated reachability matrices. } \usage{ reachability(dat, geodist.precomp=NULL, return.as.edgelist=FALSE, na.omit=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs (directed or otherwise). } \item{geodist.precomp}{ optionally, a precomputed \code{\link{geodist}} object. } \item{return.as.edgelist}{ logical; return the result as an sna edgelist? } \item{na.omit}{ logical; omit missing edges when computing reach? } } \details{ For a digraph \eqn{G=(V,E)} with vertices \eqn{i} and \eqn{j}, let \eqn{P_{ij}}{P_ij} represent a directed \eqn{ij} path. Then the (di)graph \deqn{ R = \left(V\left(G\right),\left\{\left(i,j\right):i,j \in V\left(G\right), P_{ij} \in G\right\}\right)}{% R = ( V(G), \{ (i,j): i,j in V(G), P_ij in G \} )} is said to be the \emph{reachability graph} of \eqn{G}, and the adjacency matrix of \eqn{R} is said to be \eqn{G}'s \emph{reachability matrix}. (Note that when \eqn{G} is undirected, we simply take each undirected edge to be bidirectional.) Vertices which are adjacent in the reachability graph are connected by one or more directed paths in the original graph; thus, structural equivalence classes in the reachability graph are synonymous with strongly connected components in the original structure. Bear in mind that -- as with all matters involving connectedness -- reachability is strongly related to size and density. Since, for any given density, almost all structures of sufficiently large size are connected, reachability graphs associated with large structures will generally be complete. Measures based on the reachability graph, then, will tend to become degenerate in the large \eqn{|V(G)|} limit (assuming constant positive density). By default, \code{reachability} will try to build the reachability graph using an internal sparse graph approximation; this is no help on fully connected graphs (but not a lot worse than using an adjacency matrix), but will result in considerable savings for large graphs that are heavily fragmented. (The intended design tradeoff is thus that one pays a small cost on the usually cheap cases, in exchange for much greater efficiency on the cases that would otherwise be prohibitively expensive.) If \code{geodist.precomp} is given, however, the \eqn{O(N^2)} cost of an adjacency matrix representation has already been paid, and we simply employ what we are given -- so, if you want to force the internal use of adjacency matrices, just pass a \code{\link{geodist}} object. Because the internal representation used is otherwise list based, using \code{return.as.edgelist=TRUE} will save resources; if you are using \code{reachability} as part of a more complex series of calls, it is thus recommended that you both pass and return sna edgelists unless you have a good reason not to do so. When set, \code{na.omit} results in missing edges (i.e., edges with \code{NA} values) being removed prior to computation. Since paths are not recomputed when \code{geodist.precomp} is passed, this option is only active when \code{geodist.precomp==NULL}; if this behavior is desired and precomputed distances are being used, such edges should be removed prior to the \code{\link{geodist}} call. } \value{ A reachability matrix, or the equivalent edgelist representation } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \seealso{ \code{\link{geodist}} } \examples{ #Find the reachability matrix for a sparse random graph g<-rgraph(10,tprob=0.15) rg<-reachability(g) g #Compare the two structures rg #Compare to the output of geodist all(rg==(geodist(g)$counts>0)) } \keyword{ algebra }% __ONLY ONE__ keyword per line \keyword{ graphs } sna/man/clique.census.Rd0000644000176200001440000001342413573635545014702 0ustar liggesusers\name{clique.census} \Rdversion{1.1} \alias{clique.census} \alias{cliques_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Compute Cycle Census Information } \description{ \code{clique.census} computes clique census statistics on one or more input graphs. In addition to aggregate counts of maximal cliques, results may be disaggregated by vertex and co-membership information may be computed. } \usage{ clique.census(dat, mode = "digraph", tabulate.by.vertex = TRUE, clique.comembership = c("none", "sum", "bysize"), enumerate = TRUE, na.omit = TRUE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{mode}{ \code{"digraph"} for directed graphs, or \code{"graph"} for undirected graphs. } \item{tabulate.by.vertex}{ logical; should maximal clique counts be tabulated by vertex? } \item{clique.comembership}{ the type of clique co-membership information to be tabulated, if any. \code{"sum"} returns a vertex by vertex matrix of clique co-membership counts; these are disaggregated by clique size if \code{"bysize"} is used. If \code{"none"} is given, no co-membership information is computed. } \item{enumerate}{ logical; should an enumeration of all maximal cliques be returned? } \item{na.omit}{ logical; should missing edges be omitted? } } \details{ A (maximal) \emph{clique} is a maximal set of mutually adjacenct vertices. Cliques are important for their role as cohesive subgroups, but show up in many other contexts as well. A \emph{subgraph census statistic} is a function which, for any given graph and subgraph, gives the number of copies of the latter contained in the former. A collection of subgraph census statistics is referred to as a \emph{subgraph census}; widely used examples include the dyad and triad censuses, implemented in \code{sna} by the \code{\link{dyad.census}} and \code{\link{triad.census}} functions (respectively). Likewise, \code{kpath.census} and \code{kcycle.census} compute a range of census statistics related to \eqn{k}-paths and \eqn{k}-cycles. \code{clique.census} provides similar functionality for the census of maximal cliques, including: \itemize{ \item Aggregate counts of maximal cliques by size. \item Counts of cliques to which each vertex belongs (when \code{tabulate.byvertex==TRUE}). \item Counts of clique co-memberships, potentially disaggregated by size (when the appropriate co-membership argument is set to \code{bylength}). } These calculations are intrinsically expensive (clique enumeration is NP hard in the general case), and users should be aware that computing the census can be impractical on large graphs (unless they are very sparse). On the other hand, the algorithm employed here (a variant of Makino and Uno (2004)) is generally fast enough to suport enumeration for even dense graphs of several hundred vertices on a typical desktop computer. Calling this function with \code{mode=="digraph"}, forces and initial symmetrization step, which can be avoided with \code{mode=="graph"}. While incorrectly employing the default is harmless (except for the relatively small cost of verifying symmetry), setting \code{mode=="graph"} incorrectly may result in problematic behavior. When in doubt, stick with the default. } \value{ A list with the following elements: \item{clique.count }{If \code{tabulate.byvertex==FALSE}, a vector of aggregate counts by clique size. Otherwise, a matrix whose first column is a vector of aggregate clique counts, and whose succeeding columns contain vectors of clique counts for each vertex.} \item{clique.comemb }{If \code{clique.comembership!="none"}, a matrix or array containing co-membership in cliques by vertex pairs. If \code{clique.comembership=="sum"}, only a matrix of co-memberships is returned; if \code{bysize} is used, however, co-memberships are returned in a \code{maxsize} by \eqn{n} by \eqn{n} array whose \eqn{i,j,k}th cell is the number of cliques of size \eqn{i} containing \code{j} and \code{k} (with \code{maxsize} being the size of the largest maximal clique).} \item{cliques }{If \code{enumerate=TRUE}, a list of length equal to the maximum clique size, each element of which is in turn a list of all cliques of corresponding size (given as vectors of vertices).} } \references{ Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. Makino, K. and Uno, T. (2004.) \dQuote{New Algorithms for Enumerating All Maximal Cliques.} In T. Hagerup and J. Katajainen (eds.), \emph{SWAT 2004}, LNCS 3111, 260-272. Berlin: Springer-Verlag. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ %%% ~~further notes~~ %} %% ~Make other sections like Warning with \section{Warning }{....} ~ \section{Warning }{ The computational cost of calculating cliques grows very sharply in size and network density. It is possible that the expected completion time for your calculation may exceed your life expectancy (and those of subsequent generations). } \seealso{ \code{\link{dyad.census}}, \code{\link{triad.census}}, \code{\link{kcycle.census}}, \code{\link{kpath.census}} } \examples{ #Generate a fairly dense random graph g<-rgraph(25) #Obtain cliques by vertex, with co-membership by size cc<-clique.census(g,clique.comembership="bysize") cc$clique.count #Examine clique counts cc$clique.comemb[1,,] #Isolate co-membership is trivial cc$clique.comemb[2,,] #Co-membership for 2-cliques cc$clique.comemb[3,,] #Co-membership for 3-cliques cc$cliques #Enumerate the cliques } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ graphs } \keyword{ math }% __ONLY ONE__ keyword per line sna/man/gplot.target.Rd0000644000176200001440000000665513573636372014542 0ustar liggesusers\name{gplot.target} \alias{gplot.target} \alias{gplot_layout_target_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Display a Graph in Target Diagram Form } \description{ Displays an input graph (and associated vector) as a "target diagram," with vertices restricted to lie at fixed radii from the origin. Such displays are useful ways of representing vertex characteristics and/or local structural properties for graphs of small to medium size. } \usage{ gplot.target(dat, x, circ.rad = (1:10)/10, circ.col = "blue", circ.lwd = 1, circ.lty = 3, circ.lab = TRUE, circ.lab.cex = 0.75, circ.lab.theta = pi, circ.lab.col = 1, circ.lab.digits = 1, circ.lab.offset = 0.025, periph.outside = FALSE, periph.outside.offset = 1.2, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ an input graph. } \item{x}{ a vector of vertex properties to be plotted (must match the dimensions of \code{dat}). } \item{circ.rad}{ radii at which to draw reference circles. } \item{circ.col}{ reference circle color. } \item{circ.lwd}{ reference circle line width. } \item{circ.lty}{ reference circle line type. } \item{circ.lab}{ boolean; should circle labels be displayed? } \item{circ.lab.cex}{ expansion factor for circle labels. } \item{circ.lab.theta}{ angle at which to draw circle labels. } \item{circ.lab.col}{ color for circle labels. } \item{circ.lab.digits}{ digits to display for circle labels. } \item{circ.lab.offset}{ offset for circle labels. } \item{periph.outside}{ boolean; should "peripheral" vertices be drawn together beyond the normal vertex radius? } \item{periph.outside.offset}{ radius at which "peripheral" vertices should be drawn if \code{periph.outside==TRUE}. } \item{\dots}{ additional arguments to \code{\link{gplot}}. } } \details{ \code{\link{gplot.target}} is a front-end to \code{\link{gplot}} which implements the target diagram layout of Brandes et al. (2003). This layout seeks to optimize various aesthetic criteria, given the constraint that all vertices lie at fixed radii from the origin (set by \code{x}). One important feature of this algorithm is that vertices which belong to mutual dyads (described by Brandes et al. as ``core'' vertices) are treated differently from vertices which do not (``peripheral'' vertices). Layout is optimized for core vertices prior to placing peripheral vertices; thus, the result may be misleading if mutuality is not a salient characteristic of the data. The layout for \code{gplot.target} is handled by \code{\link{gplot.layout.target}}; additional parameters are specied on the associated manual page. Standard arguments may be passed to \code{\link{gplot}}, as well. } \value{ A two-column matrix of vertex positions (generated by \code{\link{gplot.layout.target}}) } \references{ Brandes, U.; Kenis, P.; and Wagner, D. (2003). ``Communicating Centrality in Policy Network Drawings.'' \emph{IEEE Transactions on Visualization and Computer Graphics,} 9(2):241-253. } \author{Carter T. Butts \email{buttsc@uci.edu}} %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{gplot.layout.target}}, \code{\link{gplot}} } \examples{ #Generate a random graph g<-rgraph(15) #Produce a target diagram, centering by betweenness gplot.target(g,betweenness(g)) } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ hplot }% __ONLY ONE__ keyword per line sna/man/gclust.centralgraph.Rd0000644000176200001440000000406011176545402016054 0ustar liggesusers\name{gclust.centralgraph} \alias{gclust.centralgraph} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Get Central Graphs Associated with Graph Clusters } \description{ Calculates central graphs associated with particular graph clusters (as indicated by the \code{k} partition of \code{h}). } \usage{ gclust.centralgraph(h, k, dat, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{h}{ an \code{\link{hclust}} object, based on a graph stack in \code{dat}. } \item{k}{ the number of groups to evaluate. } \item{dat}{ one or more graphs (on which the clustering was performed). } \item{\dots}{ additional arguments to \code{\link{centralgraph}}. } } \details{ \code{gclust.centralgraph} uses \code{\link{cutree}} to cut the hierarchical clustering in \code{h} into \code{k} groups. \code{\link{centralgraph}} is then called on each cluster, and the results are returned as a graph stack. This is a useful tool for interpreting clusters of (labeled) graphs, with the resulting central graphs being subsequently analyzed using standard SNA methods. } \value{ An array containing the stack of central graph adjacency matrices } \references{ Butts, C.T., and Carley, K.M. (2001). ``Multivariate Methods for Interstructural Analysis.'' CASOS working paper, Carnegie Mellon University. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{hclust}}, \code{\link{centralgraph}}, \code{\link{gclust.boxstats}}, \code{\link{gdist.plotdiff}}, \code{\link{gdist.plotstats}} } \examples{ #Create some random graphs g<-rgraph(10,20,tprob=c(rbeta(10,15,2),rbeta(10,2,15))) #Find the Hamming distances between them g.h<-hdist(g) #Cluster the graphs via their Hamming distances g.c<-hclust(as.dist(g.h)) #Now find central graphs by cluster for a two cluster solution g.cg<-gclust.centralgraph(g.c,2,g) #Plot the central graphs gplot(g.cg[1,,]) gplot(g.cg[2,,]) } \keyword{ cluster }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/potscalered.mcmc.Rd0000644000176200001440000000460411176545047015336 0ustar liggesusers\name{potscalered.mcmc} \alias{potscalered.mcmc} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Compute Gelman and Rubin's Potential Scale Reduction Measure for a Markov Chain Monte Carlo Simulation} \description{ Computes Gelman and Rubin's (simplified) measure of scale reduction for draws of a single scalar estimand from parallel MCMC chains. } \usage{ potscalered.mcmc(psi) } %- maybe also `usage' for other objects documented here. \arguments{ \item{psi}{ An nxm matrix, with columns corresponding to chains and rows corresponding to iterations. } } \details{ The Gelman and Rubin potential scale reduction (\eqn{\sqrt{\hat{R}}}{sqrt(hat(R))}) provides an ANOVA-like comparison of the between-chain to within-chain variance on a given scalar estimand; the disparity between these gives an indication of the extent to which the scale of the simulated distribution can be reduced via further sampling. As the parallel chains converge \eqn{\sqrt{\hat{R}}}{sqrt(hat(R))} approaches 1 (from above), and it is generally recommended that values of 1.2 or less be obtained before a series of draws can be considered well-mixed. (Even so, one should ideally examine other indicators of chain mixing, and verify that the properties of the draws are as they should be. There is currently no fool-proof way to verify burn-in of an MCMC, but using multiple indicators should help one avoid falling prey to the idiosyncrasies of any one index.) Note that the particular estimators used in the \eqn{\sqrt{\hat{R}}}{sqrt(hat(R))} formulation are based on normal-theory results, and as such have been criticized vis a vis their behavior on other distributions. Where simulating distributions whose properties differ greatly from the normal, an alternative form of the measure using robust measures of scale (e.g., the IQR) may be preferable. } \value{ The potential scale reduction measure } \references{ Gelman, A.; Carlin, J.B.; Stern, H.S.; and Rubin, D.B. (1995). \emph{Bayesian Data Analysis.} London: Chapman and Hall. Gelman, A., and Rubin, D.B. (1992). ``Inference from Iterative Simulation Using Multiple Sequences.'' \emph{Statistical Science,} 7, 457-511. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{bbnam}}} %\examples{ % %} \keyword{ models }%-- one or more ... \keyword{univar} sna/man/rgws.Rd0000644000176200001440000001024113573637141013067 0ustar liggesusers\name{rgws} \alias{rgws} \alias{rewire.ws} \alias{rewire.ud} \alias{udrewire_R} \alias{wsrewire_R} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Draw From the Watts-Strogatz Rewiring Model } \description{ \code{rgws} generates draws from the Watts-Strogatz rewired lattice model. Given a set of input graphs, \code{rewire.ws} performs a (dyadic) rewiring of those graphs. } \usage{ rgws(n, nv, d, z, p, return.as.edgelist = FALSE) rewire.ud(g, p, return.as.edgelist = FALSE) rewire.ws(g, p, return.as.edgelist = FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{n}{ the number of draws to take. } \item{nv}{ the number of vertices per lattice dimension. } \item{d}{ the dimensionality of the underlying lattice. } \item{z}{ the nearest-neighbor threshold for local ties. } \item{p}{ the dyadic rewiring probability. } \item{g}{ a graph or graph stack. } \item{return.as.edgelist}{ logical; should the resulting graphs be returned in edgelist form?} } \details{ A Watts-Strogatz graph process generates a random graph via the following procedure. First, a \code{d}-dimensional uniform lattice is generated, here with \code{nv} vertices per dimension (i.e., \code{nv^d} vertices total). Next, all \code{z} neighbors are connected, based on geodesics of the underlying lattice. Finally, each non-null dyad in the resulting augmented lattice is "rewired" with probability \code{p}, where the rewiring operation exchanges the initial dyad state with the state of a uniformly selected null dyad sharing exactly one endpoint with the original dyad. (In the standard case, this is equivalent to choosing an endpoint of the dyad at random, and then transferring the dyadic edges to/from that endpoint to another randomly chosen vertex. Hence the "rewiring" metaphor.) For \code{p==0}, the W-S process generates (deterministic) uniform lattices, approximating a uniform G(N,M) process as \code{p} approaches 1. Thus, \code{p} can be used to tune overall entropy of the process. A well-known property of the W-S process is that (for large \code{nv^d} and small \code{p}) it generates draws with short expected mean geodesic distances (approaching those found in uniform graphs) while maintaining high levels of local "clustering" (i.e., transitivity). It has thus been proposed as one potential mechanism for obtaining "small world" structures. \code{rgws} produces independent draws from the above process, returning them as an adjacency matrix (if \code{n==1}) or array (otherwise). \code{rewire.ws}, on the other hand, applies the rewiring phase of the W-S process to one or more input graphs. This can be used to explore local perturbations of the original graphs, conditioning on the dyad census. \code{rewire.ud} is similar to \code{rewire.ws}, save in that all dyads are eligible for rewiring (not just non-null dyads), and exchanges with non-null dyads are permitted. This process may be easier to work with than standard W-S rewiring in some cases. } \value{ A graph or graph stack containing draws from the appropriate W-S process. } \references{ Watts, D. and Strogatz, S. (1998). ``Collective Dynamics of Small-world Networks.'' \emph{Nature,} 393:440-442. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ \code{rgws} generates non-toroidal lattices; some published work in this area utilizes underlying toroids, so users should check for this prior to comparing simulations against published results. } \section{Warning }{Remember that the total number of vertices in the graph is \code{nv^d}. This can get out of hand \emph{very} quickly.} \seealso{ \code{\link{rgnm}}, \code{\link{rgraph}} } \examples{ #Generate Watts-Strogatz graphs, w/increasing levels of rewiring gplot(rgws(1,100,1,2,0)) #No rewiring gplot(rgws(1,100,1,2,0.01)) #1% rewiring gplot(rgws(1,100,1,2,0.05)) #5% rewiring gplot(rgws(1,100,1,2,0.1)) #10% rewiring gplot(rgws(1,100,1,2,1)) #100% rewiring #Start with a simple graph, then rewire it g<-matrix(0,50,50) g[1,]<-1; g[,1]<-1 #Create a star gplot(g) gplot(rewire.ws(g,0.05)) #5% rewiring } \keyword{ distribution }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/ego.extract.Rd0000644000176200001440000000555410501711235014324 0ustar liggesusers\name{ego.extract} \alias{ego.extract} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Extract Egocentric Networks from Complete Network Data } \description{ \code{ego.extract} takes one or more input graphs (\code{dat}) and returns a list containing the egocentric networks centered on vertices named in \code{ego}, using adjacency rule \emph{neighborhood} to define inclusion. } \usage{ ego.extract(dat, ego = NULL, neighborhood = c("combined", "in", "out")) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ one or more graphs. } \item{ego}{ a vector of vertex IDs, or \code{NULL} if all are to be selected. } \item{neighborhood}{ the neighborhood to use. } } \details{ The egocentric network (or \dQuote{ego net}) of vertex \eqn{v} in graph \eqn{G} is defined as \eqn{G[v \cup N(v)]}{G[v U N(v)]} (i.e., the subgraph of \eqn{G} induced by \eqn{v} and its neighborhood). The neighborhood employed by \code{ego.extract} is selected by the eponymous argument: \code{"in"} selects in-neighbors, \code{"out"} selects out-neighbors, and \code{"combined"} selects all neighbors. In the event that one of the vertices selected by \code{ego} has no qualifying neighbors, \code{ego.extract} will return a degenerate (1 by 1) adjacency matrix containing that individual's diagonal entry. Vertices within the returned matrices are maintained in their original order, save for ego (who is always listed first). The ego nets themselves are returned in the order specified in the \code{ego} parameter (or their vertex order, if no value was specified). \code{ego.extract} is useful for finding local properties associated with particular vertices. To compute functions of neighbors' covariates, see \code{\link{gapply}}. } \value{ A list containing the adjacency matrices for the ego nets of each vertex in \code{ego}. } \references{ Wasserman, S. and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press.} \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ ~~further notes~~ % % ~Make other sections like Warning with \section{Warning }{....} %~ %} \seealso{ \code{\link{gapply}} } \examples{ #Generate a sample network g<-rgraph(10,tp=1.5/9) #Extract some ego nets g.in<-ego.extract(g,neighborhood="in") g.out<-ego.extract(g,neighborhood="out") g.comb<-ego.extract(g,neighborhood="in") #View some networks g.comb #Compare ego net size with degree all(sapply(g.in,NROW)==degree(g,cmode="indegree")+1) #TRUE all(sapply(g.out,NROW)==degree(g,cmode="outdegree")+1) #TRUE all(sapply(g.comb,NROW)==degree(g)/2+1) #Usually FALSE! #Calculate egocentric network density ego.size<-sapply(g.comb,NROW) if(any(ego.size>2)) sapply(g.comb[ego.size>2],function(x){gden(x[-1,-1])}) } \keyword{ math }% at least one, from doc/KEYWORDS \keyword{ graphs }% __ONLY ONE__ keyword per line sna/man/is.isolate.Rd0000644000176200001440000000272112743317520014155 0ustar liggesusers\name{is.isolate} \alias{is.isolate} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Is Ego an Isolate? } \description{ Returns TRUE iff ego is an isolate in graph \code{g} of \code{dat}. } \usage{ is.isolate(dat, ego, g=1, diag=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{ego}{ index of the vertex (or a vector of vertices) to check. } \item{g}{ which graph(s) should be examined? } \item{diag}{ boolean indicating whether adjacency matrix diagonals (i.e., loops) contain meaningful data. } } \details{ In the valued case, any non-zero edge value is taken as sufficient to establish a tie. } \value{ A boolean value (or vector thereof) indicating isolate status } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. West, D.B. (1996). \emph{Introduction to Graph Theory}. Upper Saddle River, NJ: Prentice Hall. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{isolates}}, \code{\link{add.isolates}} } \examples{ #Generate a test graph g<-rgraph(20) g[,4]<-0 #Create an isolate g[4,]<-0 #Check for isolates is.isolate(g,2) #2 is almost surely not an isolate is.isolate(g,4) #4 is, by construction } \keyword{ logic }%-- one or more ... \keyword{ graphs } sna/man/gplot.Rd0000644000176200001440000002415214667214325013240 0ustar liggesusers\name{gplot} \alias{gplot} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Two-Dimensional Visualization of Graphs } \description{ \code{gplot} produces a two-dimensional plot of graph \code{g} in collection \code{dat}. A variety of options are available to control vertex placement, display details, color, etc. } \usage{ gplot(dat, g = 1, gmode = "digraph", diag = FALSE, label = NULL, coord = NULL, jitter = TRUE, thresh = 0, thresh.absval=TRUE, usearrows = TRUE, mode = "fruchtermanreingold", displayisolates = TRUE, interactive = FALSE, interact.bycomp = FALSE, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pad = 0.2, label.pad = 0.5, displaylabels = !is.null(label), boxed.labels = FALSE, label.pos = 0, label.bg = "white", vertex.enclose = FALSE, vertex.sides = NULL, vertex.rot = 0, arrowhead.cex = 1, label.cex = 1, loop.cex = 1, vertex.cex = 1, edge.col = 1, label.col = 1, vertex.col = NULL, label.border = 1, vertex.border = 1, edge.lty = NULL, edge.lty.neg=2, label.lty = NULL, vertex.lty = 1, edge.lwd = 0, label.lwd = par("lwd"), edge.len = 0.5, edge.curve = 0.1, edge.steps = 50, loop.steps = 20, object.scale = 0.01, uselen = FALSE, usecurve = FALSE, suppress.axes = TRUE, vertices.last = TRUE, new = TRUE, layout.par = NULL, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ a graph or set thereof. This data may be valued. } \item{g}{ integer indicating the index of the graph which is to be plotted. By default, \code{g==1}. } \item{gmode}{ String indicating the type of graph being evaluated. \code{"digraph"} indicates that edges should be interpreted as directed; \code{"graph"} indicates that edges are undirected; \code{"twomode"} indicates that data should be interpreted as two-mode (i.e., rows and columns are distinct vertex sets). \code{gmode} is set to \code{"digraph"} by default. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{label}{ a vector of vertex labels, if desired; defaults to the vertex index number. } \item{coord}{ user-specified vertex coordinates, in an NCOL(dat)x2 matrix. Where this is specified, it will override the \code{mode} setting. } \item{jitter}{ boolean; should the output be jittered? } \item{thresh}{ real number indicating the lower threshold for tie values. Only ties of value >\code{thresh} (by default in absolute value - see \code{thresh.absval})are displayed. By default, \code{thresh}=0.} \item{thresh.absval}{ boolean; should the absolute value of edge weights be used when thresholding? (Defaults to TRUE; setting to FALSE leads to thresholding by signed weights.)} \item{usearrows}{ boolean; should arrows (rather than line segments) be used to indicate edges? } \item{mode}{ the vertex placement algorithm; this must correspond to a \code{\link{gplot.layout}} function. } \item{displayisolates}{ boolean; should isolates be displayed? } \item{interactive}{ boolean; should interactive adjustment of vertex placement be attempted? } \item{interact.bycomp}{ boolean; if \code{interactive==TRUE}, should all vertices in the component be moved? } \item{xlab}{ x axis label. } \item{ylab}{ y axis label. } \item{xlim}{ the x limits (min, max) of the plot. } \item{ylim}{ the y limits of the plot. } \item{pad}{ amount to pad the plotting range; useful if labels are being clipped. } \item{label.pad}{ amount to pad label boxes (if \code{boxed.labels==TRUE}), in character size units. } \item{displaylabels}{ boolean; should vertex labels be displayed? } \item{boxed.labels}{ boolean; place vertex labels within boxes? } \item{label.pos}{ position at which labels should be placed, relative to vertices. \code{0} results in labels which are placed away from the center of the plotting region; \code{1}, \code{2}, \code{3}, and \code{4} result in labels being placed below, to the left of, above, and to the right of vertices (respectively); and \code{label.pos=5} results in labels which are plotted with no offset (i.e., at the vertex positions). } \item{label.bg}{ background color for label boxes (if \code{boxed.labels==TRUE}); may be a vector, if boxes are to be of different colors.} \item{vertex.enclose}{ boolean; should vertices be enclosed within circles? (Can increase legibility for polygonal vertices.)} \item{vertex.sides}{ number of polygon sides for vertices; may be given as a vector, if vertices are to be of different types. By default, 50 sides are used (or 50 and 4, for two-mode data).} \item{vertex.rot}{ angle of rotation for vertices (in degrees); may be given as a vector, if vertices are to be rotated differently. } \item{arrowhead.cex}{ expansion factor for edge arrowheads.} \item{label.cex}{ character expansion factor for label text. } \item{loop.cex}{ expansion factor for loops; may be given as a vector, if loops are to be of different sizes. } \item{vertex.cex}{ expansion factor for vertices; may be given as a vector, if vertices are to be of different sizes. } \item{edge.col}{ color for edges; may be given as a vector or adjacency matrix, if edges are to be of different colors. } \item{label.col}{ color for vertex labels; may be given as a vector, if labels are to be of different colors. } \item{vertex.col}{ color for vertices; may be given as a vector, if vertices are to be of different colors. By default, red is used (or red and blue, for two-mode data).} \item{label.border}{ label border colors (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different colors. } \item{vertex.border}{ border color for vertices; may be given as a vector, if vertex borders are to be of different colors. } \item{edge.lty}{ line type for (positive weight) edges; may be given as a vector or adjacency matrix, if edges are to have different line types. } \item{edge.lty.neg}{ line type for negative weight edges, if any; may be given as per \code{edge.lty}.} \item{label.lty}{ line type for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line types. } \item{vertex.lty}{ line type for vertex borders; may be given as a vector or adjacency matrix, if vertex borders are to have different line types. } \item{edge.lwd}{ line width scale for edges; if set greater than 0, edge widths are scaled by \code{edge.lwd*dat}. May be given as a vector or adjacency matrix, if edges are to have different line widths. } \item{label.lwd}{ line width for label boxes (if \code{boxed.labels==TRUE}); may be given as a vector, if label boxes are to have different line widths. } \item{edge.len}{ if \code{uselen==TRUE}, curved edge lengths are scaled by \code{edge.len}. } \item{edge.curve}{ if \code{usecurve==TRUE}, the extent of edge curvature is controlled by \code{edge.curv}. May be given as a fixed value, vector, or adjacency matrix, if edges are to have different levels of curvature. } \item{edge.steps}{ for curved edges (excluding loops), the number of line segments to use for the curve approximation. } \item{loop.steps}{ for loops, the number of line segments to use for the curve approximation. } \item{object.scale}{ base length for plotting objects, as a fraction of the linear scale of the plotting region. Defaults to 0.01.} \item{uselen}{ boolean; should we use \code{edge.len} to rescale edge lengths? } \item{usecurve}{ boolean; should we use \code{edge.curve}? } \item{suppress.axes}{ boolean; suppress plotting of axes? } \item{vertices.last}{ boolean; plot vertices after plotting edges? } \item{new}{ boolean; create a new plot? If \code{new==FALSE}, vertices and edges will be added to the existing plot. } \item{layout.par}{ parameters to the \code{\link{gplot.layout}} function specified in \code{mode}. } \item{\dots}{ additional arguments to \code{\link{plot}}. } } \details{ \code{gplot} is the standard network visualization tool within the \code{sna} library. By means of clever selection of display parameters, a fair amount of display flexibility can be obtained. Graph layout -- if not specified directly using \code{coord} -- is determined via one of the various available algorithms. These should be specified via the \code{mode} argument; see \code{\link{gplot.layout}} for a full list. User-supplied layout functions are also possible -- see the aforementioned man page for details. Note that where \code{gmode=="twomode"}, the supplied two-mode network is converted to bipartite form prior to computing coordinates (if not in that form already). \code{vertex.col} or other settings may be used to differentiate row and column vertices -- by default, row vertices are drawn as red circles, and column vertices are rendered as blue squares. If \code{interactive==TRUE}, then the user may modify the initial graph layout by selecting an individual vertex and then clicking on the location to which this vertex is to be moved; this process may be repeated until the layout is satisfactory. If \code{interact.bycomp==TRUE} as well, the vertex and all other vertices in the same component as that vertex are moved together. } \value{ A two-column matrix containing the vertex positions as x,y coordinates. } \references{ Wasserman, S. and Faust, K. (1994) \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} Alex Montgomery \email{ahm@reed.edu} } %\note{ ~~further notes~~ } % ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{plot}}, \code{\link{gplot.layout}} } \examples{ gplot(rgraph(5)) #Plot a random graph gplot(rgraph(5),usecurv=TRUE) #This time, use curved edges gplot(rgraph(5),mode="mds") #Try an alternative layout scheme #A colorful demonstration... gplot(rgraph(5,diag=TRUE),diag=TRUE,vertex.cex=1:5,vertex.sides=3:8, vertex.col=1:5,vertex.border=2:6,vertex.rot=(0:4)*72, displaylabels=TRUE,label.bg="gray90") } \keyword{ graphs }% at least one, from doc/KEYWORDS \keyword{ hplot }% __ONLY ONE__ keyword per line sna/man/gvectorize.Rd0000644000176200001440000000335510501711235014257 0ustar liggesusers\name{gvectorize} \alias{gvectorize} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Vectorization of Adjacency Matrices} \description{ \code{gvectorize} takes an input graph set and converts it into a corresponding number of vectors by row concatenation. } \usage{ gvectorize(mats, mode="digraph", diag=FALSE, censor.as.na=TRUE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{mats}{ one or more input graphs. } \item{mode}{ ``digraph'' if data is taken to be directed, else ``graph''. } \item{diag}{ boolean indicating whether diagonal entries (loops) are taken to contain meaningful data. } \item{censor.as.na}{ if \code{TRUE}, code unused parts of the adjacency matrix as \code{NA}s prior to vectorizing; otherwise, unused parts are simply removed. } } \details{ The output of \code{gvectorize} is a matrix in which each column corresponds to an input graph, and each row corresponds to an edge. The columns of the output matrix are formed by simple row-concatenation of the original adjacency matrices, possibly after removing cells which are not meaningful (if \code{censor.as.na==FALSE}). This is useful when preprocessing edge sets for use with \code{glm} or the like. } \value{ An nxk matrix, where n is the number of arcs and k is the number of graphs; if \code{censor.as.na==FALSE}, n will be reflect the relevant number of uncensored arcs. } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu}} %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #Draw two random graphs g<-rgraph(10,2) #Examine the vectorized form of the adjacency structure gvectorize(g) } \keyword{ manip }%-- one or more ... \keyword{ math } \keyword{ graphs} sna/man/qaptest.Rd0000644000176200001440000001404710501711235013557 0ustar liggesusers\name{qaptest} \alias{qaptest} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Perform Quadratic Assignment Procedure (QAP) Hypothesis Tests for Graph-Level Statistics } \description{ \code{qaptest} tests an arbitrary graph-level statistic (computed on \code{dat} by \code{FUN}) against a QAP null hypothesis, via Monte Carlo simulation of likelihood quantiles. Note that fair amount of flexibility is possible regarding QAP tests on functions of such statistics (see an equivalent discussion with respect to CUG null hypothesis tests in Anderson et al. (1999)). See below for more details. } \usage{ qaptest(dat, FUN, reps=1000, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ graphs to be analyzed. Though one could in principle use a single graph, this is rarely if ever sensible in a QAP-test context.} \item{FUN}{ function to generate the test statistic. \code{FUN} must accept \code{dat} and the specified \code{g} arguments, and should return a real number. } \item{reps}{ integer indicating the number of draws to use for quantile estimation. Note that, as for all Monte Carlo procedures, convergence is slower for more extreme quantiles. By default, \code{reps}=1000. } \item{\dots}{ additional arguments to \code{FUN}. } } \details{ The null hypothesis of the QAP test is that the observed graph-level statistic on graphs \eqn{G_1,G_2,\dots} was drawn from the distribution of said statistic evaluated (uniformly) on the set of all relabelings of \eqn{G_1,G_2,\dots}. Pragmatically, this test is performed by repeatedly (randomly) relabeling the input graphs, recalculating the test statistic, and then evaluating the fraction of draws greater than or equal to (and less than or equal to) the observed value. This accumulated fraction approximates the integral of the distribution of the test statistic over the set of unlabeled input graphs. The \code{qaptest} procedure returns a \code{qaptest} object containing the estimated likelihood (distribution of the test statistic under the null hypothesis), the observed value of the test statistic on the input data, and the one-tailed p-values (estimated quantiles) associated with said observation. As usual, the (upper tail) null hypothesis is rejected for significance level alpha if p>=observation is less than alpha (or p<=observation, for the lower tail); if the hypothesis is undirected, then one rejects if either p<=observation or p>=observation is less then alpha/2. Standard caveats regarding the use of null hypothesis testing procedures are relevant here: in particular, bear in mind that a significant result does not necessarily imply that the likelihood ratio of the null model and the alternative hypothesis favors the latter. In interpreting a QAP test, it is important to bear in mind the nature of the QAP null hypothesis. The QAP test should \emph{not} be interpreted as evaluating underlying structural differences; indeed, QAP is more accurately understood as testing differences induced by a particular vertex labeling \emph{controlling for} underlying structure. Where there is substantial automorphism in the underling structures, QAP will tend to given non-significant results. (In fact, it is \emph{impossible} to obtain a one-tailed significance level in excess of \eqn{\max_{g \in \{G,H\}} \frac{|Aut(g)|}{|Perm(g)|}}{max_[g in \{G,H\}] |Aut(g)|/|Perm(g)|} when using a QAP test on a bivariate graph statistic \eqn{f(G,H)}, where Aut(g) and Perm(g) are the automorphism and permutation groups on g, respectively. This follows from the fact that all members of Aut(g) will induce the same values of \eqn{f()}.) By turns, significance under QAP does not necessarily imply that the observed structural relationship is unusual relative to what one would expect from typical structures with (for instance) the sizes and densities of the graphs in question. In contexts in which one's research question implies a particular labeling of vertices (e.g., "within this group of individuals, do friends also tend to give advice to one another"), QAP can be a very useful way of ruling out spurious structural influences (e.g., some respondents tend to indiscriminately nominate many people (without regard to whom), resulting in a structural similarity which has nothing to do with the identities of those involved). Where one's question does not imply a labeled relationship (e.g., is the \emph{shape} of this group's friendship network similar to that of its advice network), the QAP null hypothesis is inappropriate. } \value{ An object of class \code{qaptest}, containing \item{testval}{ The observed value of the test statistic. } \item{dist}{ A vector containing the Monte Carlo draws. } \item{pgreq}{ The proportion of draws which were greater than or equal to the observed value. } \item{pleeq}{ The proportion of draws which were less than or equal to the observed value. } } \references{ Anderson, B.S.; Butts, C.T.; and Carley, K.M. (1999). ``The Interaction of Size and Density with Graph-Level Indices.'' \emph{Social Networks}, 21(3), 239-267. Hubert, L.J., and Arabie, P. (1989). ``Combinatorial Data Analysis: Confirmatory Comparisons Between Sets of Matrices.'' \emph{Applied Stochastic Models and Data Analysis}, 5, 273-325. Krackhardt, D. (1987). ``QAP Partialling as a Test of Spuriousness.'' \emph{Social Networks}, 9 171-186. Krackhardt, D. (1988). ``Predicting With Networks: Nonparametric Multiple Regression Analyses of Dyadic Data.'' \emph{Social Networks}, 10, 359-382. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{cugtest}} } \examples{ #Generate three graphs g<-array(dim=c(3,10,10)) g[1,,]<-rgraph(10) g[2,,]<-rgraph(10,tprob=g[1,,]*0.8) g[3,,]<-1; g[3,1,2]<-0 #This is nearly a clique #Perform qap tests of graph correlation q.12<-qaptest(g,gcor,g1=1,g2=2) q.13<-qaptest(g,gcor,g1=1,g2=3) #Examine the results summary(q.12) plot(q.12) summary(q.13) plot(q.13) } \keyword{ htest }%-- one or more ... \keyword{ math } \keyword{ graphs } sna/man/summary.netlm.Rd0000644000176200001440000000135411176706317014724 0ustar liggesusers\name{summary.netlm} \alias{summary.netlm} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Detailed Summaries of netlm Objects } \description{ Returns a \code{netlm} summary object } \usage{ \method{summary}{netlm}(object, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{object}{ An object of class \code{netlm} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ % %} \value{ An object of class \code{summary.netlm} } %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } %~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{netlm}} } %\examples{ % %} \keyword{ math }%-- one or more ... sna/man/redist.Rd0000644000176200001440000001116113614217304013370 0ustar liggesusers\name{redist} \Rdversion{1.1} \alias{redist} %- Also NEED an '\alias' for EACH other topic documented here. \title{ Find a Matrix of Distances Between Positions Based on Regular Equivalence } \description{ \code{redist} uses the graphs indicated by \code{g} in \code{dat} to assess the extent to which each vertex is regularly equivalent; \code{method} determines the measure of approximate equivalence which is used (currently, only CATREGE). } \usage{ redist(dat, g = NULL, method = c("catrege"), mode = "digraph", diag = FALSE, seed.partition = NULL, code.diss = TRUE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{dat}{ a graph or set thereof. } \item{g}{ a vector indicating which elements of \code{dat} should be examined (by default, all are used). } \item{method}{ method to use when assessing regular equivalence (currently, only \code{"catrege"}). } \item{mode}{ \code{"digraph"} for directed data, otherwise \code{"graph"}. } \item{diag}{ logical; should diagonal entries (loops) should be treated as meaningful data? } \item{seed.partition}{ optionally, an initial equivalence partition to \dQuote{seed} the CATREGE algorithm. } \item{code.diss}{ logical; return as dissimilarities (rather than similarities)? } \item{\dots}{ additional parameters (currently ignored). } } \details{ \code{redist} provides a basic tool for assessing the (approximate) regular equivalence of actors. Two vertices \eqn{i} and \eqn{j} are said to be regularly equivalent with respect to role assignment \code{r} if \eqn{\{r(u): u\in N^+(i)\}=\{r(u): u\in N^+(j)\}}{{r(u): u in N^+(i)} = {r(u): u in N^+(j)}} and \eqn{\{r(u): u\in N^-(i)\}=\{r(u): u\in N^-(j)\}}{{r(u): u in N^-(i)} = {r(u): u in N^-(j)}}, where \eqn{N^+} and \eqn{N^-} denote out- and in-neighborhoods (respectively). RE similarity/difference scores are computed by \code{method}, currently Borgatti and Everett's CATREGE algorithm (which is based on the multiplex maximal regular equivalence on \eqn{G} and its transpose). The \dQuote{distance} between positions in this case is the inverse of the number of iterative refinements of the initial equivalence (i.e., role) structure required to allocate the positions to regularly equivalent roles (with 0 indicating positions which ultimately belong in the same role). By default, the initial equivalence structure is one in which all vertices are treated as occupying the same role; the \code{seed.partition} option can be used to impose alternative constraints. From this initial structure, vertices within the same role having non-identical mixes of neighbor types are re-allocated to different roles (where \dQuote{neighbor type} is initially due to the pattern of (possibly valued) in- and out-ties, cross-classified by current alter type). This procedure is then iterated until no further division of roles is necessary to satisfy the regularity condition. Once the similarities/differences are calculated, the results can be used with a clustering routine (such as \code{\link{equiv.clust}}) or an MDS (such as \code{\link{cmdscale}}) to identify the underlying role structure. } \value{ A matrix of similarity/difference scores. } \references{ Borgatti, S.P. and Everett, M.G. (1993). \dQuote{Two Algorithms for Computing Regular Equivalence.} \emph{Social Networks}, 15, 361-376. } \author{ Carter T. Butts \email{buttsc@uci.edu} } \note{ The maximal regular equivalence is often very uninteresting (i.e., degenerate) for unvalued, undirected graphs. An exogenous constraint (e.g., via the \code{seed.partition}) may be required to uncover a more useful refinement of the unconstrained maximal equivalence. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ \code{\link{sedist}}, \code{\link{equiv.clust}} } \examples{ #Create a random graph with _some_ edge structure g.p<-sapply(runif(20,0,1),rep,20) #Create a matrix of edge #probabilities g<-rgraph(20,tprob=g.p) #Draw from a Bernoulli graph #distribution #Get RE distances g.re<-redist(g) #Plot a metric MDS of vertex positions in two dimensions plot(cmdscale(as.dist(g.re))) #What if there were already something known to be different about #the first five vertices? sp<-rep(1:2,times=c(5,15)) #Create "seed" partition g.spre<-redist(g,seed.partition=sp) #Get new RE distances g.spre plot.sociomatrix(g.spre) #Note the blocking! } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ math } \keyword{ graphs }% __ONLY ONE__ keyword per line \keyword{ classif } \keyword{ cluster } sna/man/prestige.Rd0000644000176200001440000001007010501711234013707 0ustar liggesusers\name{prestige} \alias{prestige} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Calculate the Vertex Prestige Scores } \description{ \code{prestige} takes one or more graphs (\code{dat}) and returns the prestige scores of positions (selected by \code{nodes}) within the graphs indicated by \code{g}. Depending on the specified mode, prestige based on any one of a number of different definitions will be returned. This function is compatible with \code{\link{centralization}}, and will return the theoretical maximum absolute deviation (from maximum) conditional on size (which is used by \code{\link{centralization}} to normalize the observed centralization score). } \usage{ prestige(dat, g=1, nodes=NULL, gmode="digraph", diag=FALSE, cmode="indegree", tmaxdev=FALSE, rescale=FALSE, tol=1e-07) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graph for which centralities are to be calculated (or a vector thereof). By default, \code{g==1}. } \item{nodes}{ vector indicating which nodes are to be included in the calculation. By default, all nodes are included. } \item{gmode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{gmode} is set to "digraph" by default.} \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{cmode}{ one of "indegree", "indegree.rownorm", "indegree.rowcolnorm", "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm", "eigenvector.rowcolnorm", "domain", or "domain.proximity". } \item{tmaxdev}{ boolean indicating whether or not the theoretical maximum absolute deviation from the maximum nodal centrality should be returned. By default, \code{tmaxdev==FALSE}. } \item{rescale}{ if true, centrality scores are rescaled such that they sum to 1. } \item{tol}{ Currently ignored } } \details{ "Prestige" is the name collectively given to a range of centrality scores which focus on the extent to which one is nominated by others. The definitions supported here are as follows: \enumerate{ \item indegree: indegree centrality \item indegree.rownorm: indegree within the row-normalized graph \item indegree.rowcolnorm: indegree within the row-column normalized graph \item eigenvector: eigenvector centrality within the transposed graph (i.e., incoming ties recursively determine prestige) \item eigenvector.rownorm: eigenvector centrality within the transposed row-normalized graph \item eigenvector.colnorm: eigenvector centrality within the transposed column-normalized graph \item eigenvector.rowcolnorm: eigenvector centrality within the transposed row/column-normalized graph \item domain: indegree within the reachability graph (Lin's unweighted measure) \item domain.proximity: Lin's proximity-weighted domain prestige } Note that the centralization of prestige is simply the extent to which one actor has substantially greater prestige than others; the underlying definition is the same. } \value{ A vector, matrix, or list containing the prestige scores (depending on the number and size of the input graphs). } \references{ Lin, N. (1976). \emph{Foundations of Social Research}. New York: McGraw Hill. Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } \section{Warning }{Making adjacency matrices doubly stochastic (row-column normalization) is not guaranteed to work. In general, be wary of attempting to try normalizations on graphs with degenerate rows and columns.} \seealso{ \code{\link{centralization}}} \examples{ g<-rgraph(10) #Draw a random graph with 10 members prestige(g,cmode="domain") #Compute domain prestige scores } \keyword{univar} \keyword{ math } \keyword{ graphs } sna/man/gden.Rd0000644000176200001440000000424311601650616013017 0ustar liggesusers\name{gden} \alias{gden} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Find the Density of a Graph } \description{ \code{gden} computes the density of the graphs indicated by \code{g} in collection \code{dat}, adjusting for the type of graph in question. } \usage{ gden(dat, g=NULL, diag=FALSE, mode="digraph", ignore.eval=FALSE) } %- maybe also `usage' for other objects documented here. \arguments{ \item{dat}{ one or more input graphs. } \item{g}{ integer indicating the index of the graphs for which the density is to be calculated (or a vector thereof). If \code{g==NULL} (the default), density is calculated for all graphs in \code{dat}. } \item{diag}{ boolean indicating whether or not the diagonal should be treated as valid data. Set this true if and only if the data can contain loops. \code{diag} is \code{FALSE} by default. } \item{mode}{ string indicating the type of graph being evaluated. "digraph" indicates that edges should be interpreted as directed; "graph" indicates that edges are undirected. \code{mode} is set to "digraph" by default. } \item{ignore.eval}{ logical; should edge values be ignored when calculating density?} } \details{ The density of a graph is here taken to be the sum of tie values divided by the number of possible ties (i.e., an unbiased estimator of the graph mean); hence, the result is interpretable for valued graphs as the mean tie value when \code{ignore.eval==FALSE}. The number of possible ties is determined by the graph type (and by \code{diag}) in the usual fashion. Where missing data is present, it is removed prior to calculation. The density/graph mean is thus taken relative to the observed portion of the graph. } \value{ The graph density } \references{ Wasserman, S., and Faust, K. (1994). \emph{Social Network Analysis: Methods and Applications.} Cambridge: Cambridge University Press. } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ %\seealso{ } \examples{ #Draw three random graphs dat<-rgraph(10,3) #Find their densities gden(dat) } \keyword{ univar }%-- one or more ... \keyword{ math } \keyword{graphs} sna/man/print.summary.blockmodel.Rd0000644000176200001440000000140411176542030017035 0ustar liggesusers\name{print.summary.blockmodel} \alias{print.summary.blockmodel} %- Also NEED an `\alias' for EACH other topic documented here. \title{ Printing for summary.blockmodel Objects } \description{ Prints an object of class \code{summary.blockmodel}. } \usage{ \method{print}{summary.blockmodel}(x, ...) } %- maybe also `usage' for other objects documented here. \arguments{ \item{x}{ An object of class \code{summary.blockmodel} } \item{\dots}{ Further arguments passed to or from other methods } } %\details{ %} %\value{ %} %\references{ } \author{ Carter T. Butts \email{buttsc@uci.edu} } %\note{ } % ~Make other sections like WARNING with \section{WARNING }{....} ~ \seealso{ \code{\link{summary.blockmodel}}} %\examples{ % %} \keyword{ print }%-- one or more ... sna/DESCRIPTION0000644000176200001440000000142714667263621012562 0ustar liggesusersPackage: sna Version: 2.8 Date: 2024-09-07 Title: Tools for Social Network Analysis Authors@R: person(given=c("Carter", "T."), family="Butts", role=c("aut","cre","cph"), email = "buttsc@uci.edu") Depends: R (>= 2.0.0), utils, statnet.common, network Suggests: rgl, numDeriv, SparseM Description: A range of tools for social network analysis, including node and graph-level indices, structural distance and covariance methods, structural equivalence detection, network regression, random graph generation, and 2D/3D network visualization. License: GPL (>= 2) URL: https://statnet.org NeedsCompilation: yes Packaged: 2024-09-08 07:51:06 UTC; buttsc Author: Carter T. Butts [aut, cre, cph] Maintainer: Carter T. Butts Repository: CRAN Date/Publication: 2024-09-08 09:00:01 UTC