├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── NEWS ├── NEWS.md ├── R ├── Arroyo.R ├── HEC.R ├── HidingAnAxis.R ├── HivePlotData.R ├── HiveR-package.R ├── adj2HPD.R ├── animateHive.R ├── chkHPD.R ├── dot2HPD.R ├── drawHiveSpline.R ├── edge2HPD.R ├── manipAxis.R ├── mineHPD.R ├── plot3dHive.R ├── plotHive.R ├── ranHiveData.R ├── rcsr.R ├── sph2cart.R └── sumHPD.R ├── README.md ├── data ├── Arroyo.RData ├── HEC.RData └── Safari.RData ├── inst └── extdata │ ├── E_coli │ ├── E_coli_P.dot │ ├── E_coli_TF.dot │ ├── EdgeInst_P.csv │ ├── EdgeInst_TF.csv │ ├── NodeInst_P.csv │ ├── NodeLabels_P.csv │ └── README │ └── Misc │ ├── BlueEye.jpg │ ├── BrownEye.jpg │ ├── GreenEye.jpg │ ├── HECgraphics.txt │ ├── HECnodes.txt │ ├── HECticks.txt │ ├── HazelEye.jpg │ └── README └── man ├── Arroyo.Rd ├── HEC.Rd ├── HidingAnAxis.Rd ├── HivePlotData.Rd ├── HiveR-package.Rd ├── adj2HPD.Rd ├── animateHive.Rd ├── chkHPD.Rd ├── dot2HPD.Rd ├── drawHiveSpline.Rd ├── edge2HPD.Rd ├── manipAxis.Rd ├── mineHPD.Rd ├── plotHive.Rd ├── ranHiveData.Rd ├── rcsr.Rd ├── sph2cart.Rd └── sumHPD.Rd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | README.md 2 | Rbuildignore.txt 3 | gitignore.txt 4 | .Rhistory 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.Rhistory 2 | .DS_Store 3 | .Rapp.history 4 | .Rproj.user/ 5 | R/.Rhistory -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: HiveR 2 | Type: Package 3 | Title: 2D and 3D Hive Plots for R 4 | Version: 0.4.0 5 | Date: 2024-07-17 6 | Authors@R: c( 7 | person("Bryan A.", "Hanson", 8 | role = c("aut", "cre"), email = 9 | "hanson@depauw.edu", 10 | comment = c(ORCID = "0000-0003-3536-8246")), 11 | person("Vesna", "Memisevic", role = "ctb"), 12 | person("Jonathan", "Chung", role = "ctb")) 13 | Description: Creates and plots 2D and 3D hive plots. Hive plots are a unique method of displaying networks of many types in which node properties are mapped to axes using meaningful properties rather than being arbitrarily positioned. The hive plot concept was invented by Martin Krzywinski at the Genome Science Center (www.hiveplot.net/). Keywords: networks, food webs, linnet, systems biology, bioinformatics. 14 | License: GPL-3 15 | Imports: 16 | grid, 17 | plyr, 18 | jpeg, 19 | png, 20 | RColorBrewer, 21 | utils, 22 | stats, 23 | rgl, 24 | tcltk, 25 | xtable 26 | Suggests: 27 | bipartite 28 | URL: https://github.com/bryanhanson/HiveR 29 | ByteCompile: TRUE 30 | BugReports: https://github.com/bryanhanson/HiveR/issues 31 | Depends: R (>= 3.0) 32 | Encoding: UTF-8 33 | RoxygenNote: 7.3.2 34 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(adj2HPD) 4 | export(animateHive) 5 | export(chkHPD) 6 | export(dot2HPD) 7 | export(drawHiveSpline) 8 | export(edge2HPD) 9 | export(manipAxis) 10 | export(mineHPD) 11 | export(plot3dHive) 12 | export(plotHive) 13 | export(ranHiveData) 14 | export(rcsr) 15 | export(sph2cart) 16 | export(sumHPD) 17 | importFrom(RColorBrewer,brewer.pal) 18 | importFrom(grid,gpar) 19 | importFrom(grid,grid.curve) 20 | importFrom(grid,grid.lines) 21 | importFrom(grid,grid.newpage) 22 | importFrom(grid,grid.points) 23 | importFrom(grid,grid.raster) 24 | importFrom(grid,grid.rect) 25 | importFrom(grid,grid.segments) 26 | importFrom(grid,grid.text) 27 | importFrom(grid,pushViewport) 28 | importFrom(grid,unit) 29 | importFrom(grid,viewport) 30 | importFrom(jpeg,readJPEG) 31 | importFrom(plyr,count) 32 | importFrom(png,readPNG) 33 | importFrom(rgl,bg3d) 34 | importFrom(rgl,lines3d) 35 | importFrom(rgl,open3d) 36 | importFrom(rgl,rgl.bringtotop) 37 | importFrom(rgl,rgl.cur) 38 | importFrom(rgl,spheres3d) 39 | importFrom(rgl,text3d) 40 | importFrom(rgl,tkspinControl) 41 | importFrom(stats,na.omit) 42 | importFrom(stats,spline) 43 | importFrom(tcltk,tktoplevel) 44 | importFrom(tcltk,tkwm.title) 45 | importFrom(utils,read.csv) 46 | -------------------------------------------------------------------------------- /NEWS: -------------------------------------------------------------------------------- 1 | 2 | NEWS file for package HiveR 3 | 4 | HiveR is an R package for creating and plotting 2D and 3D hive plots. Hive plots are a unique method of displaying networks of all types in which node properties are mapped to axes rather than being arbitrarily positioned. The hive plot concept was invented by Martin Krzywinski at the Genome Science Center (www.hiveplot.com). See: 5 | 6 | Krzywinski M, Birol I, Jones S, Marra M (2011). Hive Plots - Rational 7 | Approach to Visualizing Networks. Briefings in Bioinformatics. 8 | bib.oxfordjournals.org/content/early/2011/12/09/bib.bbr069.abstract 9 | doi: 10.1093/bib/bbr069 10 | 11 | Bryan A. Hanson DePauw University, Greencastle Indiana USA 12 | 13 | See below for various contributors and those that reported bugs. Much appreciated! 14 | 15 | Changes in version 0.3.42 2017-07-27 16 | + Moved documentation to roxygen. 17 | + Fixed suggests vs imports per B.D. Ripley. 18 | + Implemented check for virtual edges as described below (sumHPD). For consistency, this required changes to the check for edges starting and ending on the same node, and corresponding changes in mineHPD which can remove these types of edges. 19 | + Vignette updated. 20 | 21 | Changes in version 0.2.78 2016-06-05 22 | + Fixed a bug in mineHPD(HPD, option = "remove self edge"). Original report of a related problem by FinScience in issue #15. There were two problems: 1. A change in base R's handling of factors, and 2. HiveR was failing to check for what I am now calling virtual self edges: edges that originate and end from nodes on the same axis at the same radius but are actually different nodes (as opposed to true self edges which are an edge that begins and ends on the same node). THIS CODE STILL NEEDS TO BE IMPLEMENTED in sumHPD with a new option chk.virt.edge or something similar. 23 | 24 | Changes in version 0.2.55 2016-03-25 25 | + Fixed a problem with a 1-pixel line around the entire plot in plotHive. Not sure when this appeared. Noted by 6C3C41 issue #12. Thanks! 26 | 27 | Changes in version 0.2.48 2016-02-55 28 | + annotateNodes, a helper function defined in plotHive, gains the ... argument. This allows argument rot to apply to node annotation. This will conflict with rotating the axes labels, but the latter are easily added manually in a separate step. 29 | 30 | Changes in version 0.2.46 2016-01-25 31 | + chkHPD now checks for negative values for edge weights (width) and node sizes. A warning is issued if these are found (They will certainly throw an error if one tries to plot). 32 | 33 | Changes in version 0.2.44 2015-07-26 34 | + NEWS file reformatted. 35 | + Updated to work with R 3.3 devel (changes in namespace policies). In the process several packages were moved from Imports to Suggests, giving a leaner install. 36 | + Versions are now numbered x.y.z going forward. 37 | + Updated the ignore file infrastructure. 38 | + Updated the DESCRIPTION language for new CRAN style. 39 | + Added an example of constructing a dummy / phantom axis or node, as well as an example illustrating how to put two plots on one page. Both are in ?HidingAnAxis which is aliased to ?TwoPlotsOnePage. 40 | + Fixed a problem with adj2HPD when processing symmetric matrices. 41 | 42 | Changes in version 0.2-28 2015-01-20 43 | + UpCITATION file for CRAN. 44 | + Removed obsolete cart2sph function (actually, it was never used). 45 | + Builds and checks with R 3.2/devel 46 | + animateHive looks a little wonky currently. Either crashes, or works partially, declaring it can't find a function that doesn't seem to exist. 47 | 48 | Changes in version 0.2-27 2014-06-02 49 | + Tidy things up for CRAN. 50 | 51 | Changes in version 0.2-26 2014-06-02 52 | + Added a check for a symmetric input matrix in adj2HPD. If this is the case, a message is given and the lower triangle is used. Thanks to James Kitson for the example that revealed this problem. 53 | + Improvements to documentation, small changes to vignette for CRAN. 54 | + Added an example of drawing tick marks to plotHive (and HECticks.txt added to inst/extdata/Misc) 55 | 56 | Changes in version 0.2-25 2014-04-15 57 | + Removed a leftover print statement from edge2HPD. Darn it! 58 | 59 | Changes in version 0.2-24 2014-03-11 60 | + Added checking for a valid option in manipAxis. 61 | + Added methods "offset" and "stretch" in manipAxis. 62 | + Added a check in chkHPD to make sure all radii > 0. This is just in case some of the new options in manipAxis backfire. 63 | + Revised examples for manipAxis. 64 | + Removed some unneeded print statements from manipAxis. 65 | 66 | Changes in version 0.2-23 2014-02-22 67 | + Added checking for a valid option in mineHPD. 68 | 69 | Changes in version 0.2-22 2014-01-26 70 | + Freshened up README.md 71 | + Added R.buildignore 72 | + In plotHive, graphic annotations can now be either jpg or png, and is autodetected. 73 | 74 | Changes in version 0.2-21 2013-12-06 75 | + Improved HEC and plotHive documentation. 76 | + Added files to extdata/Misc to use with plotHive examples. 77 | 78 | Changes in version 0.2-20 2013-12-05 79 | + Added a built-in data set based up the hair eye color data set supplied with R. See ?HEC. 80 | 81 | Changes in version 0.2-19 2013-12-05 82 | + Vectorized the reading of graphics in plotHive (only the first one was being read). 83 | 84 | Changes in version 0.2-18 2013-12-04 85 | + Added the ability to place graphics as annotations on 2D plots. Requested by Suma Jayakrishna. 86 | + For 2D plots, one can now specify the location of the annotation (or graphic) using either a global specification or a specification local to a specific node. See ?plotHive. 87 | + In plotHive, added helper function getCoord. 88 | + Updated plotHive documentation. 89 | 90 | Changes in version 0.2-17 2013-09-20 91 | + Fix another vignette issue to pass CRAN. 92 | + Really removed dependencies on RFOC as previously claimed, from several places! 93 | + Removed ppiData from imports. 94 | 95 | Changes in version 0.2-16 2013-09-12 96 | + Fix a vignette issue to pass CRAN. 97 | 98 | Changes in version 0.2-15 2013-09-11 99 | + At CRAN's request, added .Rbuildignore 100 | + At CRAN's request, added vignette builder engine. 101 | 102 | 103 | Changes in version 0.2-14 2013-08-16 104 | + Added depends R >= 3.0 to pass all checks at CRAN. 105 | 106 | Changes in version 0.2-13 2013-08-14 107 | + Moved vignette to vignettes directory for CRAN. Various small fixes to vignette. 108 | + Fixed an importFrom issue. 109 | + Fixed a problem with edge2HPD found by V. Memisevic. Added a better example to the documentation. 110 | 111 | Changes in version 0.2-12 2013-07-22 112 | + Vesna Memisevic discovered that adj2HPD assumed bipartite networks in how it processed the data. Modified the code so that this assumption is not made and other types of adjacency matrices can be read. 113 | + Added edge2HPD authored by Jonathan H. Chung. Thanks! 114 | + Updated documentation and related files. 115 | 116 | Changes in version 0.2-11 2013-07-06 117 | + Modified dot2HPD to handle multiple tag=value entries. 118 | + Small clarifications to documentation. 119 | 120 | Changes in version 0.2-10 2013-02-29 121 | + Added tcltk to dependencies and some importFrom in NAMESPACE to pass CRAN. 122 | 123 | Changes in version 0.2-9 2013-02-29 124 | + Removed dependency on RFOC due to licensing issue there. 125 | 126 | Changes in version 0.2-8 2013-02-29 127 | + Compatible with R 3.0.0 128 | + Fixed some documentation problems and tuned up github site. 129 | + NULL value for edge.inst in dot2HPD was not being caught (thanks to Gordon Robertson for pointing this out). 130 | 131 | Changes in version 0.2-7 2012-10-05 132 | + Cleaned up a few non-code issues to pass CRAN checks. 133 | 134 | Changes in version 0.2-6 2012-10-02 135 | + Fixed a problem with edge sizes and weights not being handled correctly for some cases with plotHive (so 2D hives only). 136 | 137 | Changes in version 0.2-5 2012-09-16 138 | + Fixed a problem in which 2D hive node sizes and colors were not being drawn correctly. Reported by Augustin Arce along with a suggested fix. Thanks Augustin! The same problem was in the 3D version and was also corrected. The edge colors and weights do not appear to have the problem; they are assembled from scratch. 139 | 140 | Changes in version 0.2-4 2012-06-25 141 | + Improved vignette, now built using knitr outside of the build/check process 142 | + Added additional files for the E coli data set. See inst/extdata/E_coli/README for details. 143 | + Revised animateHive to permit different hives to be animated using different sets of arguments. Gives maximum flexibility. See the help page for a silly example. 144 | 145 | Changes in version 0.2-3 2012-06-11 146 | + Improved the Dot parsing in dot2HPD. Among others, node.inst or edge.inst may be NULL (if both are NULL, you aren't doing much, this is untested). 147 | + Added options to mineHPD. 148 | + Possible problem with prune being ignored (still out there!). 149 | 150 | Changes in version 0.2-2 2012-06-07 151 | + Possible problem with prune being ignored. 152 | + Added function animateHive to do rotation and scaling of type = "3D" hive plots (in sync if there is more than one hive given). 153 | + Added method = prune to manipAxis which allows one to prune (remove) an axis from an HPD. 154 | + Modified sumHPD to include a count of edges between each axis pair. 155 | + Fixed a warning about "incomplete final line" which NodeInst.csv and EdgeInst.csv were giving. 156 | + Fixed a few documentation errors. 157 | 158 | Changes in version 0.2-1 2011-12-11 159 | + This version is 0.1-6 renumbered to 0.2-1 to go to CRAN. 160 | 161 | Changes in version 0.1-6 2011-12-10 162 | + This version currently on Github devel branch. 163 | + Turned on byte compiling. 164 | + Removed argument center.hole from dot2HPD. 165 | + Added a new function adj2HPD which will convert adjacency matrices to HPDs. 166 | + Modified plotHive so that it is able to draw edges beginning and ending on the same axis (see below too). 167 | + Moved a chunk of code in plotHive that was needlessly being repeated for each set of edge draws. Greatly improved speed. 168 | + Fixed a detail in plotHive which may have resulted in edge colors and weights not being correctly matched with the edge. 169 | + Added axis labeling to plotHive and plot3dHive. 170 | + Added the ability to draw an arrow "legend" to plotHive. 171 | + Added the ability to label nodes in plotHive. This probably needs some tweaking to work really well. 172 | + Added options "ranknorm" and "invert" to manipAxis. 173 | + Removed center.hole from the definition of an HPD as it is not intrinsically part of the hive. Instead, this information is now an argument to the plotting routines. Updated all documentation and data structures. 174 | + Added argument "allow.same" to ranHiveData. This allows edges to begin and end on the same axis. In previous versions such edges were automatically cleaned out, and that is still the default. This only applies to type = 2D. 175 | + Added argument "chk.same.pt" to sumHPD which checks to see if any of the edges start and end at the same point (which causes an error in plotHive). This is necessary because with the addition of allowing edges to begin and end on the same axis, it was revealed that some data sets (like the E. coli regulatory network) may have edges that not only begin and end on the same axis but also have the same radius (if degree was used to set the radius), so one is attempting to draw an edge of length zero which is what gives the error. This condition might arise because of errors in the data set or during processing the condition may arise. Either way, one needs to be able to detect it for removal or alteration. 176 | + Added argument "chk.ax.jump" to sumHPD which looks for edges which jump over an axis (e.g. axis 1 --> axis 3). This is undesirable in type = 2D plots. 177 | + Added argument "chk.orphan.node" to sumHPD which looks for orphaned nodes (nodes which don't have any edges). 178 | + Added argument "chk.sm.axis" to sumHPD which looks to see which edges start and end on the same axis. 179 | + Added argument "chk.all" to sumHPD which turns on all these checks at once. 180 | + Added argument "orphan.list" so that a data frame of the orphans can be returned. 181 | + Added option "remove orphans" to mineHPD which removes nodes which have not edges. 182 | + Made improvements to vignette. 183 | 184 | Changes in version 0.1-5 2011-11-21 185 | + This version currently on Github only (note: never went to CRAN). 186 | + Small change in rcsr which increased spline computation speed by over 20x by removing hidden redraws of the empty graphics window. I should have seen that one a long time ago! 187 | + Small change in drawHiveSpline which eliminated the empty graphic window which is no longer necessary. 188 | + Discovered that using lines3d from rgl with line_antialias = TRUE was a huge bottleneck (duh!). By turning this off, another 20x or more improvement was obtained in testing. However, one can see the difference upon close inspection, at least for smaller hives. Added an argument, LA = T/F to plot3dHive to control this feature. 189 | + Added method "scale" to manipAxis so that individual axes can be scaled separately. 190 | + Removed function centerHole() as it is easier to get consistent and predictable behavior by merely specifying a value for HPD$center.hole directly. Changed the drawing functions appropriately. Plan to move center.hole out of the HPD object definition in the next version. 191 | + Removed internal adjustments which scaled node size. Now node size is taken directly from the HPD. 192 | + Enhanced sumHPD to include a listing of radii range for each axis. Helpful in setting up and trouble-shooting plots. 193 | 194 | Changes in version 0.1-4 2011-11-17 195 | + Some small changes to pass CRAN checks 196 | 197 | Changes in version 0.1-3 2011-11-14 198 | + Added nx = 4-6 for plotHive (2D mode). Also added checking for empty sets of edges to plot, which gives an error when grid.curve is called. 199 | + Updated and expanded vignette. 200 | + Added function dot2HPD which processes graphs in .dot format into HPD objects, using auxiliary files which contain processing information. Only supports some aspects of the .dot standard, but additional features are relatively easy to add. 201 | + Added function mineHPD which will read an HPD and extract further information from it. The result is an updated HPD. This function is intended to be easily extensible. 202 | + Numerous small improvements to the underlying code and the plot appearance. 203 | + Added the E. coli data set to the extdata folder. 204 | 205 | Changes in version 0.1-2 2011-11-09 206 | + This version is not going to CRAN. 207 | + Internal changes primarily. 208 | + Expanded vignette. 209 | + Added argument "type" to ranHiveData so that plots with 4-6 axes can be randomly generated in a 2D mode. This seems to work but is not fully tested. Next step is to make plotHive handle 4-6 axes. 210 | + In class HivePlotData, changed "dim" to axes, and added a descriptor "type" which indicates if the hive data is 2D or 3D. 211 | 212 | Changes in version 0.1-1 2011-10-20 213 | + First Release of the main functions. Finally! 214 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # HiveR 0.4.0 2024-07-17 2 | ## Miscellaneous 3 | * Removed vignette due to several problems; will hopefully be returned soon. 4 | 5 | # HiveR 0.3.63 2020-06-08 6 | ## Miscellaneous 7 | * Adjustments to `DESCRIPTION`: added `tint` and `rmarkdown` to `Suggests`. Reported by BD Ripley. Also added `Encoding: UTF-8` field. 8 | 9 | # HiveR 0.3.55 2020-05-07 10 | ## Miscellaneous 11 | * Built and checked against R 4.0, with necessary adjustments. 12 | * Package `tkrgl` has been merged into `rgl` and will be deprecated eventually. Relevant functions/usage in `HiveR` updated. Thanks to Duncan Murdoch for the heads up and detailed suggestions! 13 | * Code styled. 14 | * Vignette updated to use markdown and `tint`. Minor adjustments to content. 15 | 16 | ## Notices 17 | * As of May 2020 this (NEWS.md) is the change log/NEWS document. Older news may be found by downloading the package source from CRAN and locating the NEWS file. 18 | -------------------------------------------------------------------------------- /R/Arroyo.R: -------------------------------------------------------------------------------- 1 | 2 | 3 | #' Plant-Pollinator Data Sets in Hive Plot Data Format 4 | #' 5 | #' Plant-pollinator data sets which were derived ultimately from Vasquez and 6 | #' Simberloff, 2003. These are two-trophic level systems that have almost 7 | #' exactly the same plants and pollinators. \code{Safari} is from an 8 | #' undisturbed area, while \code{Arroyo} is from a nearby location grazed by 9 | #' cattle. In the original publication, the data sets are called Safariland 10 | #' and Arroyo Goye. See Details for how the original data was converted. 11 | #' 12 | #' These data sets are \code{\link{HivePlotData}} objects. They were created 13 | #' from the datasets \code{Safariland} and \code{vazarr} in the package 14 | #' \code{bipartite}. The process was the same for each: 1. Plants were placed 15 | #' on one axis, pollinators on the other. 2. A radius was assigned by 16 | #' calculating d' using function \code{dfun} in package \code{bipartite}. d' 17 | #' is an index of specialization; higher values mean the plant or pollinator is 18 | #' more specialized. 3. Edge weights were assigned proportional to the square 19 | #' root of the normalized number of visits of a pollinator to a plant. Thus 20 | #' the width of the edge drawn is an indication of the visitation rate. 4. 21 | #' The number of visits were divided manually into 4 groups and used to assign 22 | #' edge colors ranging from white to red. The redder colors represent greater 23 | #' numbers of visits, and the color-coding is comparable for each data set. 24 | #' 25 | #' 26 | #' 27 | #' @name Arroyo 28 | #' @docType data 29 | #' @aliases Arroyo Safari 30 | #' @author Bryan A. Hanson, DePauw University, Greencastle Indiana USA 31 | #' @keywords datasets 32 | NULL 33 | -------------------------------------------------------------------------------- /R/HEC.R: -------------------------------------------------------------------------------- 1 | 2 | #' A HivePlotData Object of the Hair Eye Color Data Set 3 | #' 4 | #' This is an \code{\link{HPD}} (\code{HivePlotData} object) derived from the 5 | #' built-in hair eye color data set (see \code{?HairEyeColor}). It serves as a 6 | #' test 2D data set, and the example below shows how it was built. While every 7 | #' data set is different and will require a different approach, the example 8 | #' illustrates the general approach to building a hive plot from scratch, 9 | #' step-by-step. 10 | #' 11 | #' 12 | #' @name HEC 13 | #' @docType data 14 | #' @format The format is described in detail at \code{\link{HPD}}. 15 | #' @keywords datasets 16 | #' @examples 17 | #' 18 | #' # An example of building an HPD from scratch 19 | #' 20 | #' ### Step 0. Get to know your data. 21 | #' 22 | #' data(HairEyeColor) # see ?HairEyeColor for background 23 | #' df <- data.frame(HairEyeColor) # str(df) is useful 24 | #' 25 | #' # Frequencies of the colors can be found with: 26 | #' eyeF <- aggregate(Freq ~ Eye, data = df, FUN = "sum") 27 | #' hairF <- aggregate(Freq ~ Hair, data = df, FUN = "sum") 28 | #' es <- eyeF$Freq / eyeF$Freq[4] # node sizes for eye 29 | #' hs <- hairF$Freq / hairF$Freq[3] # node sizes for hair 30 | #' 31 | #' ### Step 1. Assemble a data frame of the nodes. 32 | #' 33 | #' # There are 32 rows in the data frame, but we are going to 34 | #' # separate the hair color from the eye color and thus 35 | #' # double the number of rows in the node data frame 36 | #' 37 | #' nodes <- data.frame( 38 | #' id = 1:64, 39 | #' lab = paste(rep(c("hair", "eye"), each = 32), 1:64, sep = "_"), 40 | #' axis = rep(1:2, each = 32), 41 | #' radius = rep(NA, 64) 42 | #' ) 43 | #' 44 | #' for (n in 1:32) { 45 | #' # assign node radius based most common colors 46 | #' if (df$Hair[n] == "Black") nodes$radius[n] <- 2 47 | #' if (df$Hair[n] == "Brown") nodes$radius[n] <- 4 48 | #' if (df$Hair[n] == "Red") nodes$radius[n] <- 1 49 | #' if (df$Hair[n] == "Blond") nodes$radius[n] <- 3 50 | #' 51 | #' if (df$Eye[n] == "Brown") nodes$radius[n + 32] <- 1 52 | #' if (df$Eye[n] == "Blue") nodes$radius[n + 32] <- 2 53 | #' if (df$Eye[n] == "Hazel") nodes$radius[n + 32] <- 3 54 | #' if (df$Eye[n] == "Green") nodes$radius[n + 32] <- 4 55 | #' 56 | #' # now do node sizes 57 | #' if (df$Hair[n] == "Black") nodes$size[n] <- hs[1] 58 | #' if (df$Hair[n] == "Brown") nodes$size[n] <- hs[2] 59 | #' if (df$Hair[n] == "Red") nodes$size[n] <- hs[3] 60 | #' if (df$Hair[n] == "Blond") nodes$size[n] <- hs[4] 61 | #' 62 | #' if (df$Eye[n] == "Brown") nodes$size[n + 32] <- es[4] 63 | #' if (df$Eye[n] == "Blue") nodes$size[n + 32] <- es[3] 64 | #' if (df$Eye[n] == "Hazel") nodes$size[n + 32] <- es[2] 65 | #' if (df$Eye[n] == "Green") nodes$size[n + 32] <- es[1] 66 | #' } 67 | #' 68 | #' nodes$color <- rep("black", 64) 69 | #' nodes$lab <- as.character(nodes$lab) # clean up some data types 70 | #' nodes$radius <- as.numeric(nodes$radius) 71 | #' 72 | #' ### Step 2. Assemble a data frame of the edges. 73 | #' 74 | #' edges <- data.frame( # There will be 32 edges, corresponding to the original 32 rows 75 | #' id1 = c(1:16, 49:64), # This will set up edges between each eye/hair pair 76 | #' id2 = c(33:48, 17:32), # & put the males above and the females below 77 | #' weight = df$Freq, 78 | #' color = rep(c("lightblue", "pink"), each = 16) 79 | #' ) 80 | #' 81 | #' edges$color <- as.character(edges$color) 82 | #' 83 | #' # Scale the edge weight (det'd by trial & error to emphasize differences) 84 | #' edges$weight <- 0.25 * log(edges$weight)^2.25 85 | #' 86 | #' ### Step 3. Now assemble the HivePlotData (HPD) object. 87 | #' 88 | #' HEC <- list() 89 | #' HEC$nodes <- nodes 90 | #' HEC$edges <- edges 91 | #' HEC$type <- "2D" 92 | #' HEC$desc <- "HairEyeColor data set" 93 | #' HEC$axis.cols <- c("grey", "grey") 94 | #' class(HEC) <- "HivePlotData" 95 | #' 96 | #' ### Step 4. Check it & summarize 97 | #' 98 | #' chkHPD(HEC) # answer of FALSE means there are no problems 99 | #' sumHPD(HEC) 100 | #' 101 | #' ### Step 5. Plot it. 102 | #' 103 | #' # A minimal plot 104 | #' plotHive(HEC, ch = 0.1, bkgnd = "white") 105 | #' # See ?plotHive for fancier options 106 | NULL 107 | -------------------------------------------------------------------------------- /R/HidingAnAxis.R: -------------------------------------------------------------------------------- 1 | 2 | #' How to Hide An Axis in a Hive Plot, with Bonus 2 Plots on One Page 3 | #' 4 | #' From time-to-time is useful to compare several hive plots based on related 5 | #' data (and you might wish to plot them side-by-side to facilitate 6 | #' comparison). Depending the nature of the data set and how it changes under 7 | #' the experimental design, some data sets may not have any nodes on a 8 | #' particular axis (and therefore, they don't participate in edges either). 9 | #' Let's say your system fundamentally has three axes, but in some data sets 10 | #' one of the axes has no nodes. When you plot them side-by-side, for visual 11 | #' comparison it is nice if all the plots, including the one with an empty 12 | #' axis, have the same general orientation. In other words, even if the data 13 | #' only requires two axes, you might want it plotted as if it had three axes 14 | #' for consistency in overall appearance. 15 | #' 16 | #' When an axis is present but doesn't have a node on it, this makes 17 | #' \code{plotHive} unhappy, but there is a simple solution. You simply put a 18 | #' dummy or phantom node on the empty axis. This is illustrated in the example 19 | #' below. Also demonstrated is a simple \code{grid}-based function for putting 20 | #' more than one plot on a device. 21 | #' 22 | #' 23 | #' @aliases HidingAnAxis TwoPlotsOnePage 24 | #' @name HidingAnAxis 25 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 26 | #' @examples 27 | #' 28 | #' require("grid") 29 | #' 30 | #' # Adjacency matrix describing the connectivity in 2-butanone 31 | #' # H's on a single carbon collapsed into a group. 32 | #' # Matrix entry is bond order. CH3 is coded so the 33 | #' # bond order between C & H is 3 (3 single C-H bonds) 34 | #' 35 | #' dnames <- c("C1", "C2", "C3", "C4", "O", "HC1", "HC3", "HC4") 36 | #' 37 | #' # C1, C2, C3, C4, O, HC1, HC3, HC4 38 | #' butanone <- matrix(c( 39 | #' 0, 1, 0, 0, 0, 3, 0, 0, # C1 40 | #' 1, 0, 1, 0, 2, 0, 0, 0, # C2 41 | #' 0, 1, 0, 1, 0, 0, 2, 0, # C3 42 | #' 0, 0, 1, 0, 0, 0, 0, 3, # C4 43 | #' 0, 2, 0, 0, 0, 0, 0, 0, # O 44 | #' 3, 0, 0, 0, 0, 0, 0, 0, # HC1 45 | #' 0, 0, 2, 0, 0, 0, 0, 0, # HC3 46 | #' 0, 0, 0, 3, 0, 0, 0, 0 47 | #' ), # HC4 48 | #' ncol = 8, byrow = TRUE, 49 | #' dimnames = list(dnames, dnames) 50 | #' ) 51 | #' 52 | #' butanoneHPD <- adj2HPD( 53 | #' M = butanone, axis.col = c("black", "gray", "red"), 54 | #' desc = "2-butanone" 55 | #' ) 56 | #' 57 | #' # Fix up the nodes manually (carbon is on axis 1) 58 | #' butanoneHPD$nodes$axis[5] <- 3L # oxygen on axis 3 59 | #' butanoneHPD$nodes$axis[6:8] <- 2L # hydrogen on axis 2 60 | #' butanoneHPD$nodes$color[5] <- "red" 61 | #' butanoneHPD$nodes$color[6:8] <- "gray" 62 | #' 63 | #' # Exaggerate the edge weights, which are proportional to the number of bonds 64 | #' butanoneHPD$edges$weight <- butanoneHPD$edges$weight^2 65 | #' butanoneHPD$edges$color <- rep("wheat3", 7) 66 | #' 67 | #' plotHive(butanoneHPD, 68 | #' method = "rank", bkgnd = "white", 69 | #' axLabs = c("carbon", "hydrogen", "oxygen"), 70 | #' axLab.pos = c(1, 1, 1), axLab.gpar = 71 | #' gpar(col = c("black", "gray", "red")) 72 | #' ) 73 | #' 74 | #' # Now repeat the process for butane 75 | #' 76 | #' dnames <- c("C1", "C2", "C3", "C4", "HC1", "HC2", "HC3", "HC4") 77 | #' 78 | #' # C1, C2, C3, C4, HC1, HC2, HC3, HC4 79 | #' butane <- matrix(c( 80 | #' 0, 1, 0, 0, 3, 0, 0, 0, # C1 81 | #' 1, 0, 1, 0, 0, 2, 0, 0, # C2 82 | #' 0, 1, 0, 1, 0, 0, 2, 0, # C3 83 | #' 0, 0, 1, 0, 0, 0, 0, 3, # C4 84 | #' 3, 0, 0, 0, 0, 0, 0, 0, # HC1 85 | #' 0, 2, 0, 0, 0, 0, 0, 0, # HC2 86 | #' 0, 0, 2, 0, 0, 0, 0, 0, # HC3 87 | #' 0, 0, 0, 3, 0, 0, 0, 0 88 | #' ), # HC4 89 | #' ncol = 8, byrow = TRUE, 90 | #' dimnames = list(dnames, dnames) 91 | #' ) 92 | #' 93 | #' butaneHPD <- adj2HPD( 94 | #' M = butane, axis.col = c("black", "gray"), 95 | #' desc = "butane" 96 | #' ) 97 | #' butaneHPD$nodes$axis[5:8] <- 2L # hydrogen on axis 2 98 | #' butaneHPD$nodes$color[5:8] <- "gray" 99 | #' butaneHPD$edges$weight <- butaneHPD$edges$weight^2 100 | #' butaneHPD$edges$color <- rep("wheat3", 7) 101 | #' 102 | #' plotHive(butaneHPD, 103 | #' method = "rank", bkgnd = "white", 104 | #' axLabs = c("carbon", "hydrogen"), 105 | #' axLab.pos = c(1, 1), axLab.gpar = gpar(col = c("black", "gray")) 106 | #' ) 107 | #' 108 | #' # butaneHPD has 2 axes. If we wanted to compare to butanoneHPD effectively 109 | #' # we should add a third dummy axis where the oxygen axis was in butanone 110 | #' # You might want to look at str(butaneHPD) before beginning 111 | #' 112 | #' dummy <- c(9, "dummy", 3, 1.0, 1.0, "white") # mixed data types 113 | #' # but coerced to character 114 | #' butaneHPD$nodes <- rbind(butaneHPD$nodes, dummy) 115 | #' str(butaneHPD$nodes) # The data types are mangled from the rbind! 116 | #' 117 | #' # Now coerce the data types to the standard of the class, and check it 118 | #' butaneHPD$nodes$id <- as.integer(butaneHPD$nodes$id) 119 | #' butaneHPD$nodes$axis <- as.integer(butaneHPD$nodes$axis) 120 | #' butaneHPD$nodes$radius <- as.numeric(butaneHPD$nodes$radius) 121 | #' butaneHPD$nodes$size <- as.numeric(butaneHPD$nodes$size) 122 | #' str(butaneHPD$nodes) 123 | #' 124 | #' chkHPD(butaneHPD) # OK! (False means there were no problems) 125 | #' sumHPD(butaneHPD) 126 | #' 127 | #' # Plot it 128 | #' 129 | #' plotHive(butaneHPD, 130 | #' method = "rank", bkgnd = "white", 131 | #' axLabs = c("carbon", "hydrogen", "oxygen"), 132 | #' axLab.pos = c(1, 1, 1), axLab.gpar = 133 | #' gpar(col = c("black", "gray", "red")) 134 | #' ) 135 | #' 136 | #' # Put 2 plots side-by-side using a little helper function 137 | #' 138 | #' vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y) 139 | #' 140 | #' # pdf("Demo.pdf", width = 10, height = 5) # Aspect ratio better 141 | #' # default screen device 142 | #' 143 | #' grid.newpage() 144 | #' pushViewport(viewport(layout = grid.layout(1, 2))) 145 | #' pushViewport(vplayout(1, 1)) # left plot 146 | #' 147 | #' plotHive(butanoneHPD, 148 | #' method = "rank", bkgnd = "white", 149 | #' axLabs = c("carbon", "hydrogen", "oxygen"), 150 | #' axLab.pos = c(1, 1, 1), axLab.gpar = 151 | #' gpar(col = c("black", "gray", "red")), np = FALSE 152 | #' ) 153 | #' grid.text("butanone", 154 | #' x = 0.5, y = 0.1, default.units = "npc", 155 | #' gp = gpar(fontsize = 14, col = "black") 156 | #' ) 157 | #' 158 | #' popViewport(2) 159 | #' pushViewport(vplayout(1, 2)) # right plot 160 | #' grid.text("test2") 161 | #' 162 | #' plotHive(butaneHPD, 163 | #' method = "rank", bkgnd = "white", 164 | #' axLabs = c("carbon", "hydrogen", "oxygen"), 165 | #' axLab.pos = c(1, 1, 1), axLab.gpar = 166 | #' gpar(col = c("black", "gray", "red")), np = FALSE 167 | #' ) 168 | #' grid.text("butane", 169 | #' x = 0.5, y = 0.1, default.units = "npc", 170 | #' gp = gpar(fontsize = 14, col = "black") 171 | #' ) 172 | #' 173 | #' # dev.off() 174 | NULL 175 | -------------------------------------------------------------------------------- /R/HivePlotData.R: -------------------------------------------------------------------------------- 1 | 2 | #' Hive Plot Data Objects 3 | #' 4 | #' In package \code{HiveR}, hive plot data sets are stored as an S3 class 5 | #' called \code{HivePlotData}, detailed below. 6 | #' 7 | #' 8 | #' @note While \code{$edges$id1} and \code{$edges$id2} are defined as the 9 | #' starting and ending nodes of a particular edge, hive plots as currently 10 | #' implemented are not directed graphs (agnostic might be a better word). \cr 11 | #' \cr \code{HPD$type} indicates the type of hive data: If \code{2D}, then the 12 | #' data is intended to be plotted with \code{hivePlot} which is a 2D plot with 13 | #' axes radially oriented, and (hopefully) no edges that cross axes. If 14 | #' \code{3D}, then the data is intended to be plotted with \code{plot3dHive} 15 | #' which gives an interactive 3D plot, with axes oriented in 3D. 16 | #' 17 | #' @section Structure: The structure of a \code{HivePlotData} object is a list 18 | #' of 6 elements, some of which are data frames, and an attribute, as follows: 19 | #' 20 | #' \tabular{llll}{ 21 | #' \emph{element} \tab \emph{(element)} \tab \emph{type} \tab \emph{description}\cr 22 | #' $nodes \tab \tab data frame \tab Data frame of node properties \cr 23 | #' \tab $id \tab int \tab Node identifier \cr 24 | #' \tab $lab \tab chr \tab Node label \cr 25 | #' \tab $axis \tab int \tab Axis to which node is assigned \cr 26 | #' \tab $radius \tab num \tab Radius (position) of node along the axis \cr 27 | #' \tab $size \tab num \tab Node size in pixels \cr 28 | #' \tab $color \tab chr \tab Node color \cr 29 | #' $edges \tab \tab data frame \tab Data frame of edge properties \cr 30 | #' \tab $id1 \tab int \tab Starting node id \cr 31 | #' \tab $id2 \tab int \tab Ending node id \cr 32 | #' \tab $weight \tab num \tab Width of edge in pixels \cr 33 | #' \tab $color \tab chr \tab Edge color \cr 34 | #' $type \tab \tab chr \tab Type of hive. See Note. \cr 35 | #' $desc \tab \tab chr \tab Description of data \cr 36 | #' $axis.cols \tab \tab chr \tab Colors for axes \cr 37 | #' - attr \tab \tab chr "HivePlotData" \tab The S3 class designation.\cr } 38 | #' 39 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 40 | #' 41 | #' @seealso \code{\link{sumHPD}} to summarize a \code{HivePlotData} object.\cr 42 | #' \code{\link{chkHPD}} to verify the integrity of a \code{HivePlotData} 43 | #' object.\cr \code{\link{ranHiveData}} to generate random \code{HivePlotData} 44 | #' objects for testing and demonstration. 45 | #' 46 | #' @keywords classes 47 | #' @name HivePlotData 48 | #' @aliases HPD HivePlotData 49 | 50 | #' @examples 51 | #' 52 | #' test4 <- ranHiveData(nx = 4) 53 | #' str(test4) 54 | #' sumHPD(test4) 55 | #' plotHive(test4) 56 | NULL 57 | -------------------------------------------------------------------------------- /R/HiveR-package.R: -------------------------------------------------------------------------------- 1 | 2 | #' 2D and 3D Hive Plots for R 3 | #' 4 | #' Creates and plots 2D and 3D hive plots. Hive plots are a unique method of 5 | #' displaying networks of many types in which node properties are mapped to 6 | #' axes using meaningful properties rather than being arbitrarily positioned. 7 | #' The hive plot concept was invented by Martin Krzywinski at the Genome 8 | #' Science Center (www.hiveplot.net/). Keywords: networks, food webs, linnet, 9 | #' systems biology, bioinformatics. 10 | #' 11 | #' 12 | #' @name HiveR-package 13 | #' @aliases HiveR-package HiveR 14 | #' @docType package 15 | #' @author Bryan A. Hanson, DePauw University, Greencastle Indiana USA 16 | #' @keywords package 17 | "_PACKAGE" 18 | -------------------------------------------------------------------------------- /R/adj2HPD.R: -------------------------------------------------------------------------------- 1 | #' Process an Adjacency Graph into a HivePlotData Object 2 | #' 3 | #' This function will take an adjacency graph and convert it into a basic 4 | #' \code{\link{HivePlotData}} object. Further manipulation by 5 | #' \code{\link{mineHPD}} will almost certainly be required before the data can 6 | #' be plotted. 7 | #' 8 | #' This function produces a "bare bones" \code{HivePlotData} object. The names 9 | #' of the dimensions of \code{M} are used as the node names. All nodes are 10 | #' given size 1, an id number (\code{1:number of nodes}), are colored black and 11 | #' are assigned to axis 1. The edges are all gray, and the weight is M[i,j]. 12 | #' The user will likely have to manually make some changes to the resulting 13 | #' \code{HivePlotData} object before plotting. Alternatively, 14 | #' \code{\link{mineHPD}} may be able to extract some information buried in the 15 | #' data, but even then, the user will probably need to make some adjustments. 16 | #' See the examples. 17 | #' 18 | #' @param M A matrix with named dimensions. The names should be the node 19 | #' names. Should not be symmetric. If it is, only the lower triangle is used 20 | #' and a message is given. 21 | #' 22 | #' @param axis.cols A character vector giving the colors desired for the axes. 23 | #' 24 | #' @param type One of \code{c("2D", "3D")}. If \code{2D}, a 25 | #' \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 26 | #' be created and the eventual hive plot will be static and 2D. If \code{3D}, 27 | #' the \code{HivePlotData} object will be suitable for a 3D interactive plot 28 | #' using \code{\link{plot3dHive}}. 29 | #' 30 | #' @param desc Character. A description of the data set. 31 | #' 32 | #' @param \dots Other parameters to be passed downstream. 33 | #' 34 | #' @return A \code{ \link{HivePlotData}} object. 35 | #' 36 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} Vesna 37 | #' Memisevic contributed a fix that limited this function to bipartite networks 38 | #' (changed in v. 0.2-12). 39 | #' 40 | #' @seealso \code{\link{dot2HPD}} and \code{\link{adj2HPD}} 41 | #' 42 | #' @keywords utilities 43 | #' 44 | #' @importFrom RColorBrewer brewer.pal 45 | #' 46 | #' @export adj2HPD 47 | #' 48 | #' @examples 49 | #' 50 | #' ### Example 1: a bipartite network 51 | #' ### Note: this first example has questionable scientific value! 52 | #' ### The purpose is to show how to troubleshoot and 53 | #' ### manipulate a HivePlotData object. 54 | #' 55 | #' if (require("bipartite")) { 56 | #' data(Safariland, package = "bipartite") # This is a bipartite network 57 | #' 58 | #' # You may wish to do ?Safariland or ?Safari for background 59 | #' 60 | #' hive1 <- adj2HPD(Safariland, desc = "Safariland data set from bipartite") 61 | #' sumHPD(hive1) 62 | #' 63 | #' # Note that all nodes are one axis with radius 1. Process further: 64 | #' 65 | #' hive2 <- mineHPD(hive1, option = "rad <- tot.edge.count") 66 | #' sumHPD(hive2) 67 | #' 68 | #' # All nodes still on 1 axis but degree has been used to set radius 69 | #' 70 | #' # Process further: 71 | #' 72 | #' hive3 <- mineHPD(hive2, option = "axis <- source.man.sink") 73 | #' sumHPD(hive3, chk.all = TRUE) 74 | #' 75 | #' # Note that mineHPD is generating some warnings, telling us 76 | #' # that the first 9 nodes were not assigned to an axis. Direct 77 | #' # inspection of the data shows that these nodes are insects 78 | #' # that did not visit any of the flowers in this particular study. 79 | #' 80 | #' # Pretty up a few things, then plot: 81 | #' 82 | #' hive3$edges$weight <- sqrt(hive3$edges$weight) * 0.5 83 | #' hive3$nodes$size <- 0.5 84 | #' plotHive(hive3) 85 | #' 86 | #' # This is a one-sided hive plot of 2 axes, which results 87 | #' # from the curvature of the splines. We can manually fix 88 | #' # this by reversing the ends of edges as follows: 89 | #' 90 | #' for (n in seq(1, length(hive3$edges$id1), by = 2)) { 91 | #' a <- hive3$edges$id1[n] 92 | #' b <- hive3$edges$id2[n] 93 | #' hive3$edges$id1[n] <- b 94 | #' hive3$edges$id2[n] <- a 95 | #' } 96 | #' 97 | #' plotHive(hive3) 98 | #' 99 | #' ### Example 2, a simple random adjacency matrix 100 | #' set.seed(31) 101 | #' nr <- 20 102 | #' nc <- 15 103 | #' M <- matrix(floor(runif(nc * nr, 0, 10)), ncol = nc) 104 | #' colnames(M) <- sample(c(letters, LETTERS), nc, replace = FALSE) 105 | #' rownames(M) <- sample(c(letters, LETTERS), nr, replace = FALSE) 106 | #' hive4 <- adj2HPD(M) 107 | #' sumHPD(hive4) 108 | #' } 109 | #' 110 | adj2HPD <- function(M = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) { 111 | 112 | # Function to read adjacency matrices and convert to HPD 113 | # Bryan Hanson, DePauw Univ, December 2011 114 | # Part of HiveR package 115 | 116 | # Assumptions/Caveats: 117 | 118 | # No checking for whether the type (2D/3D) is actually true/relevant 119 | # Without outside info, many parameters have to be set arbitrarily 120 | # and perhaps changed later. 121 | 122 | if (is.null(M)) stop("No adjacency matrix provided") 123 | if (is.null(dimnames(M))) stop("Adjacency matrix must have named dimensions") 124 | if (isSymmetric(M)) { 125 | message("Matrix is symmetric, using only the lower triangle") 126 | M[upper.tri(M)] <- 0 127 | } 128 | 129 | lab1 <- unlist(dimnames(M)[1]) 130 | lab1 <- as.character(lab1) 131 | lab2 <- unlist(dimnames(M)[2]) 132 | lab2 <- as.character(lab2) 133 | d1 <- dim(M)[1] 134 | d2 <- dim(M)[2] 135 | 136 | nn <- length(unique(c(lab1, lab2))) 137 | size <- rep(1, nn) 138 | id <- 1:nn 139 | axis <- rep(1, nn) 140 | color <- as.character(rep("black", nn)) 141 | radius <- rep(1, nn) 142 | 143 | # Set up HPD$nodes 144 | 145 | HPD <- list() 146 | HPD$nodes$id <- id 147 | labNames <- unique(c(lab1, lab2)) # VM fix v. 0.2-12 148 | HPD$nodes$lab <- labNames # VM fix v. 0.2-12 149 | HPD$nodes$axis <- axis 150 | HPD$nodes$radius <- radius 151 | HPD$nodes$size <- size 152 | HPD$nodes$color <- color 153 | 154 | # Set up HPD$edges 155 | 156 | id1 <- id2 <- v <- c() # v = value of M[i, j] 157 | for (i in 1:d1) { 158 | for (j in 1:d2) { 159 | if (!M[i, j] == 0) { 160 | id1 <- c(id1, which(lab1[i] == labNames)) # VM fix v. 0.2-12 161 | id2 <- c(id2, which(lab2[j] == labNames)) # VM fix v. 0.2-12 162 | v <- c(v, M[i, j]) 163 | } 164 | } 165 | } 166 | 167 | if (!length(id1) == length(id2)) stop("Something is wrong with the M[i,j] counts") 168 | ne <- length(id1) 169 | 170 | HPD$edges$id1 <- id1 171 | HPD$edges$id2 <- id2 172 | HPD$edges$weight <- v 173 | HPD$edges$color <- rep("gray", ne) 174 | 175 | # Final clean-up 176 | 177 | HPD$nodes <- as.data.frame(HPD$nodes) 178 | HPD$edges <- as.data.frame(HPD$edges) 179 | 180 | if (is.null(desc)) desc <- "No description provided" 181 | HPD$desc <- desc 182 | 183 | if (is.null(axis.cols)) axis.cols <- RColorBrewer::brewer.pal(length(unique(HPD$nodes$axis)), "Set1") 184 | HPD$axis.cols <- axis.cols 185 | 186 | HPD$nodes$axis <- as.integer(HPD$nodes$axis) 187 | HPD$nodes$size <- as.numeric(HPD$nodes$size) 188 | HPD$nodes$color <- as.character(HPD$nodes$color) 189 | HPD$nodes$lab <- as.character(HPD$nodes$lab) 190 | 191 | HPD$edges$id1 <- as.integer(HPD$edges$id1) 192 | HPD$edges$id2 <- as.integer(HPD$edges$id2) 193 | HPD$edges$weight <- as.numeric(HPD$edges$weight) 194 | HPD$edges$color <- as.character(HPD$edges$color) 195 | 196 | HPD$type <- type 197 | 198 | class(HPD) <- "HivePlotData" 199 | 200 | chkHPD(HPD) 201 | 202 | HPD 203 | } # The very end! 204 | -------------------------------------------------------------------------------- /R/animateHive.R: -------------------------------------------------------------------------------- 1 | #' Animate One or More 3D Hive Plots with a Handy Controller 2 | #' 3 | #' This function takes a list of \code{HivePlotData} objects of \code{type = 4 | #' "3D"} and plots each in its own \code{rgl} window using its own arguments, 5 | #' then adds a controller which handles rotation and scaling. 6 | #' 7 | #' 8 | #' @param hives A list of \code{HivePlotData} objects. 9 | #' 10 | #' @param cmds A list of arguments corresponding to how you want each hive 11 | #' plotted. 12 | #' 13 | #' @param xy An integer giving the size of the \code{rgl} window in pixels. 14 | #' 15 | #' @param \dots Other parameters to be passed downstream to \code{rgl}. 16 | #' 17 | #' @return None. Side effect is one or more plots. 18 | #' 19 | #' @section Warning: If you click the 'continue rotating' box on the controller 20 | #' window, be sure to unclick it and wait for the system to halt before closing 21 | #' any of the windows. If you close the controller w/o doing this, the 22 | #' remaining open windows with the hive plots will continue rotating endlessly 23 | #' and it seems you can't get their attention to close the windows. 24 | #' 25 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 26 | #' 27 | #' @keywords interactive 28 | #' 29 | #' @export animateHive 30 | #' 31 | #' @importFrom rgl open3d rgl.bringtotop rgl.cur tkspinControl 32 | #' @importFrom tcltk tktoplevel tkwm.title 33 | #' 34 | #' @examples 35 | #' 36 | #' \dontrun{ 37 | #' require("rgl") 38 | #' # Sillyness: let's draw different hives with different settings 39 | #' # List of hives 40 | #' t4 <- ranHiveData(type = "3D", nx = 4) 41 | #' t5 <- ranHiveData(type = "3D", nx = 5) 42 | #' t6 <- ranHiveData(type = "3D", nx = 6) 43 | #' myhives <- list(t4, t5, t6) 44 | #' # List of arguments to plot in different coordinate systems 45 | #' cmd1 <- list(method = "abs", LA = TRUE, dr.nodes = FALSE, ch = 10) 46 | #' cmd2 <- list(method = "rank", LA = TRUE, dr.nodes = FALSE, ch = 2) 47 | #' cmd3 <- list(method = "norm", LA = TRUE, dr.nodes = FALSE, ch = 0.1) 48 | #' mycmds <- list(cmd1, cmd2, cmd3) 49 | #' # 50 | #' animateHive(hives = myhives, cmds = mycmds) 51 | #' } 52 | #' 53 | animateHive <- function(hives = list(), cmds = list(), xy = 400, ...) { 54 | 55 | # Function to create coordinated rgl animations 56 | # using different plotting arguments for each hive plot 57 | 58 | if (!requireNamespace("rgl", quietly = TRUE)) { 59 | stop("You need to install package rgl to use this function") 60 | } 61 | 62 | nh <- length(hives) 63 | if (nh == 0) stop("No hives specified") 64 | 65 | # Draw each hive in its own window w/its own parameters 66 | 67 | win.list <- c() 68 | 69 | for (n in 1:nh) { 70 | type <- hives[[n]]$type 71 | if (!type == "3D") { 72 | msg <- paste("Hive no.", n, "is not 3D", sep = " ") 73 | warning(msg) 74 | next 75 | } 76 | rgl::open3d(windowRect = c(0, 0, xy, xy)) 77 | win.name <- paste("window", rgl::rgl.cur(), sep = "") 78 | win.list <- c(win.list, win.name) 79 | rgl::rgl.bringtotop(TRUE) 80 | do.call(plot3dHive, args = c(hives[n], cmds[[n]])) 81 | # Since hives is a list of lists, you must unlist it one level 82 | } 83 | 84 | # Set up a controller 85 | base <- tcltk::tktoplevel() 86 | tcltk::tkwm.title(base, "Master Controls") 87 | devL <- as.integer(gsub("window", "", win.list)) 88 | con <- rgl::tkspinControl(base, dev = devL) 89 | } 90 | -------------------------------------------------------------------------------- /R/chkHPD.R: -------------------------------------------------------------------------------- 1 | #' Verify the Integrity of a Hive Plot Data Object 2 | #' 3 | #' This function inspects the classes of each part of a \code{\link{HPD}} as a 4 | #' means of verifying its integrity. A few other characteristics are checked 5 | #' as well. 6 | #' 7 | #' 8 | #' @param HPD An object of S3 class \code{HivePlotData}. 9 | #' 10 | #' @param confirm Logical; if \code{TRUE} then a favorable result is affirmed 11 | #' in the console (problems are always reported). 12 | #' 13 | #' @return A logical value; \code{TRUE} is there is a problem, otherwise 14 | #' \code{FALSE}. 15 | #' 16 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 17 | #' 18 | #' @seealso \code{\link{sumHPD}} which allows inspection (checking) of many 19 | #' properties of your \code{\link{HPD}}. 20 | #' 21 | #' @keywords utilities 22 | #' 23 | #' @export chkHPD 24 | #' 25 | #' @examples 26 | #' 27 | #' test4 <- ranHiveData(nx = 4) 28 | #' good <- chkHPD(test4, confirm = TRUE) 29 | #' # mess it up and do again 30 | #' # next test is not run as it halts execution 31 | #' \dontrun{ 32 | #' test4$nodes$color <- as.factor(test4$nodes$color) 33 | #' bad <- chkHPD(test4) 34 | #' } 35 | #' 36 | chkHPD <- function(HPD, confirm = FALSE) { 37 | 38 | # Function to Check the Integrity of HPD Objects 39 | # Bryan Hanson, DePauw University, Oct 2011 40 | # Part of HiveR package 41 | 42 | if (missing(HPD)) stop("Nothing to check") 43 | w <- FALSE 44 | 45 | if (!inherits(HPD, "HivePlotData")) { 46 | warning("The object provided was not of class HivePlotData") 47 | w <- TRUE 48 | } 49 | 50 | if (!inherits(HPD$nodes, "data.frame")) { 51 | warning("The nodes data appear to be corrupt") 52 | w <- TRUE 53 | } 54 | if (!inherits(HPD$nodes$id, "integer")) { 55 | warning("nodes$id appears to be corrupt") 56 | w <- TRUE 57 | } 58 | if (!inherits(HPD$nodes$radius, "numeric")) { 59 | warning("nodes$radius appears to be corrupt") 60 | w <- TRUE 61 | } 62 | if (!inherits(HPD$nodes$lab, "character")) { 63 | warning("nodes$lab appears to be corrupt") 64 | w <- TRUE 65 | } 66 | if (!inherits(HPD$nodes$axis, "integer")) { 67 | warning("nodes$axis appears to be corrupt") 68 | w <- TRUE 69 | } 70 | if (!inherits(HPD$nodes$color, "character")) { 71 | warning("nodes$color appears to be corrupt") 72 | w <- TRUE 73 | } 74 | if (!inherits(HPD$nodes$size, "numeric")) { 75 | warning("nodes$size appears to be corrupt") 76 | w <- TRUE 77 | } 78 | 79 | if (!inherits(HPD$edges, "data.frame")) { 80 | warning("The edges data appear to be corrupt") 81 | w <- TRUE 82 | } 83 | if (!inherits(HPD$edges$id1, "integer")) { 84 | warning("edges$id1 appears to be corrupt") 85 | w <- TRUE 86 | } 87 | if (!inherits(HPD$edges$id2, "integer")) { 88 | warning("edges$id2 appears to be corrupt") 89 | w <- TRUE 90 | } 91 | if (!inherits(HPD$edges$weight, "numeric")) { 92 | warning("edges$weight appears to be corrupt") 93 | w <- TRUE 94 | } 95 | if (!inherits(HPD$edges$color, "character")) { 96 | warning("edges$color appears to be corrupt") 97 | w <- TRUE 98 | } 99 | 100 | 101 | if (!inherits(HPD$desc, "character")) { 102 | warning("The description appears to be corrupt") 103 | w <- TRUE 104 | } 105 | if (!inherits(HPD$axis.cols, "character")) { 106 | warning("axis.cols appears to be corrupt") 107 | w <- TRUE 108 | } 109 | 110 | if (!((HPD$type == "2D") | (HPD$type == "3D"))) { 111 | warning("Type must be 2D or 3D") 112 | w <- TRUE 113 | } 114 | 115 | if (any(HPD$nodes$radius < 0)) warning("Some node radii < 0; the behavior of these is unknown") 116 | if (any(HPD$nodes$size < 0)) warning("Some node sizes < 0; the behavior of these is unknown") 117 | if (any(HPD$edges$weight < 0)) warning("Some edge widths (weights) < 0; the behavior of these is unknown") 118 | 119 | if ((!w) && (confirm)) cat("You must be awesome: This hive plot data looks dandy!") 120 | if (w) { 121 | cat("*** There seem to be one or more problems with this hive plot data!\n") 122 | stop("Sorry, we can't continue this way: It's not me, it's you!\n") 123 | } 124 | 125 | return(w) 126 | } 127 | -------------------------------------------------------------------------------- /R/dot2HPD.R: -------------------------------------------------------------------------------- 1 | #' Process a .dot Graph File into a Hive Plot Data Object 2 | #' 3 | #' This function will read a .dot file containing a graph specification in the 4 | #' DOT language, and (optionally) using two other files, convert the 5 | #' information into a \code{\link{HivePlotData}} object. 6 | #' 7 | #' This function is currently agnostic with respect to whether or not the .dot 8 | #' graph is directed or not. Either type will be processed, but if the graph 9 | #' is directed, this will only be indirectly stored in the \code{HivePlotData} 10 | #' object (in that the first node of an edge in the .dot file will be in 11 | #' \code{HPD$nodes$id1} and the second node of an edge will be in 12 | #' \code{HPD$nodes$id2}. This fact can be used; see the vignette and 13 | #' \code{\link{mineHPD}}. Keep in mind the .dot standard is fairly loose. 14 | #' This function has been tested to work with several .dot files, include those 15 | #' with multiple tag=value attributes (in such cases, a typical line in the dot 16 | #' file should be formatted like this: node_name [tag1 = value1, tag2 = 17 | #' value2];). If you have trouble, please file a issue at Github so I can 18 | #' track it down. 19 | #' 20 | #' @param file The path to the .dot file to be processed. 21 | #' 22 | #' @param node.inst The path to a .csv file containing instructions about how 23 | #' to map node tags in the .dot file to parameters in the \code{HivePlotData} 24 | #' object. May be NULL. 25 | #' 26 | #' @param edge.inst The path to a .csv file containing instructions about how 27 | #' to map edge tags in the .dot file to parameters in the \code{HivePlotData} 28 | #' object. May be NULL. 29 | #' 30 | #' @param axis.cols A character vector giving the colors desired for the axes. 31 | #' 32 | #' @param type One of \code{c("2D", "3D")}. If \code{2D}, a 33 | #' \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 34 | #' be created and the eventual hive plot will be static and 2D. If \code{3D}, 35 | #' the \code{HivePlotData} object will be suitable for a 3D interactive plot 36 | #' using \code{\link{plot3dHive}}. 37 | #' 38 | #' @param desc Character. A description of the data set. 39 | #' 40 | #' @param \dots Other parameters to be passed downstream. 41 | #' 42 | #' @return A \code{\link{HivePlotData}} object. 43 | #' 44 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 45 | #' 46 | #' @seealso See the vignette for an example of using this function. Use 47 | #' \code{browseVignettes("HiveR")} to produce the vignette. \cr \cr 48 | #' \code{\link{adj2HPD}} for a means of importing adjacency matrices. 49 | #' 50 | #' @keywords utilities 51 | #' 52 | #' @importFrom RColorBrewer brewer.pal 53 | #' 54 | #' @export dot2HPD 55 | #' 56 | dot2HPD <- function(file = NULL, node.inst = NULL, edge.inst = NULL, 57 | axis.cols = NULL, type = "2D", desc = NULL, ...) { 58 | 59 | # Function to read dot files and convert to HPD 60 | # Bryan Hanson, DePauw Univ, July 2011 61 | 62 | # Assumptions/Caveats/Features: 63 | # No distinction between undirected and directed graphs 64 | # Not sure how A -- B -- C would be handled 65 | # Multiple tag=value entries OK 66 | 67 | # No checking for whether the type (2D/3D) is actually true 68 | 69 | if (is.null(node.inst)) message("No node instructions provided, proceeding without them") 70 | if (is.null(edge.inst)) message("No edge instructions provided, proceeding without them") 71 | 72 | lines <- readLines(file, ...) 73 | 74 | # Clean off 1st and last lines which contain { and } 75 | # And clean out leading and trailing spaces 76 | 77 | lines <- lines[-grep("\\{", lines)] # cleans off 1st line 78 | lines <- lines[-grep("\\}", lines)] # cleans off last line 79 | lines <- gsub("^[[:space:]]|[[:space:]]$", "", lines) # leading spaces + trailing spaces 80 | lines <- sub(";", "", lines) 81 | 82 | # The following will find edges and their attributes 83 | 84 | ed <- lines[grep("--|->", lines)] 85 | ed <- unique(ed) # just in case 86 | 87 | # Find nodes and their attributes by inverting the edge pattern 88 | 89 | no <- lines[-grep("--|->", lines)] 90 | no <- unique(no) # just in case 91 | 92 | # Initialize HPD$nodes 93 | 94 | HPD <- list() 95 | HPD$nodes$id <- 1:length(no) 96 | HPD$nodes$lab <- gsub("\\[.*\\]$", "", no) # strips off any attributes 97 | HPD$nodes$lab <- gsub("[[:space:]]", "", HPD$nodes$lab) # strips off any spaces 98 | HPD$nodes$axis <- rep(1, length(no)) 99 | HPD$nodes$radius <- rep(1, length(no)) 100 | HPD$nodes$size <- rep(1, length(no)) 101 | HPD$nodes$color <- rep("transparent", length(no)) 102 | 103 | # Process node attributes 104 | # Collect multiple tag=value sets with their node info 105 | 106 | 107 | if (!is.null(node.inst)) { 108 | # get the node names (everything not an attribute) 109 | nn <- sub("\\[.*\\]$", "", no) 110 | nn <- gsub("[[:space:]]", "", nn) 111 | # get the entire list of attributes 112 | nats <- sub("^.*\\[", "", no) # clean off front 113 | nats <- sub("\\]$", "", nats) # clean off back 114 | nats <- strsplit(nats, ",", fixed = TRUE) # returns a list of attributes for each node 115 | # it works even if there is no ',' i.e. only one attribute (very handy) 116 | 117 | # read in translation instructions 118 | ni <- read.csv(node.inst, stringsAsFactors = FALSE) 119 | 120 | # loop over the list & match up instructions 121 | 122 | for (i in 1:length(nats)) { # match up instructions 123 | tagval <- unlist(nats[i]) 124 | tagval <- gsub("[[:space:]]", "", tagval) 125 | for (j in 1:length(tagval)) { 126 | tv <- unlist(strsplit(tagval[j], "=", fixed = TRUE)) 127 | for (k in 1:nrow(ni)) { 128 | # cat("Node no. = ", i, "attribute no = ", j, "node inst = ", k, "\n") 129 | if ((tv[1] == ni$dot.tag[k]) & (tv[2] == ni$dot.val[k])) { 130 | # only certain hive.tag values are valid & will be processed 131 | # other values are silently ignored 132 | # more options readily added 133 | 134 | if (ni$hive.tag[k] == "axis") { 135 | HPD$nodes$axis[i] <- as.numeric(ni$hive.val[k]) 136 | } 137 | if (ni$hive.tag[k] == "radius") { 138 | HPD$nodes$radius[i] <- as.numeric(ni$hive.val[k]) 139 | } 140 | if (ni$hive.tag[k] == "size") { 141 | HPD$nodes$size[i] <- as.numeric(ni$hive.val[k]) 142 | } 143 | if (ni$hive.tag[k] == "color") { 144 | HPD$nodes$color[i] <- ni$hive.val[k] 145 | } 146 | } 147 | } 148 | } 149 | } 150 | } # end of !is.null(node.inst) & node processing 151 | 152 | # Set up HPD$edges 153 | 154 | HPD$edges$id1 <- rep(1, length(ed)) 155 | HPD$edges$id2 <- rep(1, length(ed)) 156 | HPD$edges$weight <- rep(1, length(ed)) 157 | HPD$edges$color <- rep("gray", length(ed)) 158 | 159 | # Match up the two node names in the input file 160 | # with the node ids created above and add to HPD$edges 161 | 162 | # remove attributes, remove -- or ->, strip white space, keep 2 names together 163 | 164 | ed_prs <- sub("\\[.*$", "", ed) # remove attributes 165 | ed_prs <- gsub("[[:space:]]", "", ed_prs) # remove any whitespace 166 | 167 | for (n in 1:(length(ed_prs))) { 168 | # print(n) 169 | pat1 <- sub("(--|->).*$", "", ed_prs[n]) 170 | pat2 <- sub("^.*(--|->)", "", ed_prs[n]) 171 | # print(pat1) 172 | # print(pat2) 173 | pat1 <- paste("\\b", pat1, "\\b", sep = "") # need word boundaries 174 | pat2 <- paste("\\b", pat2, "\\b", sep = "") # to avoid finding fragments 175 | HPD$edges$id1[n] <- grep(pat1, HPD$nodes$lab) 176 | HPD$edges$id2[n] <- grep(pat2, HPD$nodes$lab) 177 | } 178 | 179 | # # Process edge attributes 180 | 181 | if (!is.null(edge.inst)) { 182 | # get the entire list of attributes 183 | eats <- sub("^.*\\[", "", ed) # clean off front 184 | eats <- sub("\\]$", "", eats) # clean off back 185 | # print(head(eats)) 186 | eats <- strsplit(eats, ",", fixed = TRUE) # returns a list of attributes for each edge 187 | # it works even if there is no ',' i.e. only one attribute (very handy) 188 | # print(head(eats)) 189 | # read in translation instructions 190 | ei <- read.csv(edge.inst, stringsAsFactors = FALSE) 191 | 192 | # loop over the list & match up instructions 193 | 194 | for (i in 1:length(eats)) { # match up instructions 195 | tagval <- unlist(eats[i]) 196 | tagval <- gsub("[[:space:]]", "", tagval) 197 | for (j in 1:length(tagval)) { 198 | tv <- unlist(strsplit(tagval[j], "=", fixed = TRUE)) 199 | for (k in 1:nrow(ei)) { 200 | # cat("Edge no. = ", i, "attribute no = ", j, "edge inst = ", k, "\n") 201 | if ((tv[1] == ei$dot.tag[k]) & (tv[2] == ei$dot.val[k])) { 202 | # only certain hive.tag values are valid & will be processed 203 | # other values are silently ignored 204 | # more options readily added 205 | 206 | if (ei$hive.tag[k] == "weight") { 207 | HPD$edges$weight[i] <- as.numeric(ei$hive.val[k]) 208 | } 209 | if (ei$hive.tag[k] == "color") { 210 | HPD$edges$color[i] <- as.character(ei$hive.val[k]) 211 | } 212 | } 213 | } 214 | } 215 | } 216 | } # end of !is.null(edge.inst) & edge processing 217 | 218 | # Final clean-up 219 | 220 | HPD$nodes <- as.data.frame(HPD$nodes) 221 | HPD$edges <- as.data.frame(HPD$edges) 222 | 223 | if (is.null(desc)) desc <- "No description provided" 224 | HPD$desc <- desc 225 | 226 | if (is.null(axis.cols)) axis.cols <- RColorBrewer::brewer.pal(length(unique(HPD$nodes$axis)), "Set1") 227 | HPD$axis.cols <- axis.cols 228 | 229 | HPD$nodes$axis <- as.integer(HPD$nodes$axis) 230 | HPD$nodes$size <- as.numeric(HPD$nodes$size) 231 | HPD$nodes$color <- as.character(HPD$nodes$color) 232 | HPD$nodes$lab <- as.character(HPD$nodes$lab) 233 | 234 | HPD$edges$id1 <- as.integer(HPD$edges$id1) 235 | HPD$edges$id2 <- as.integer(HPD$edges$id2) 236 | HPD$edges$weight <- as.numeric(HPD$edges$weight) 237 | HPD$edges$color <- as.character(HPD$edges$color) 238 | 239 | HPD$type <- type 240 | 241 | class(HPD) <- "HivePlotData" 242 | 243 | chkHPD(HPD) 244 | 245 | HPD 246 | } # The very end! 247 | -------------------------------------------------------------------------------- /R/drawHiveSpline.R: -------------------------------------------------------------------------------- 1 | #' Draw a 3D Spline as Part of a 3D Hive Plot 2 | #' 3 | #' This function analyzes the edges of a \code{HivePlotData} object in order to 4 | #' draw 3D splines representing those edges. Each pair of nodes at the ends of 5 | #' an edge is identified, and a control point is computed. This information is 6 | #' passed to \code{\link{rcsr}} to work out the details. 7 | #' 8 | #' 9 | #' @param HPD An object of S3 class \code{HivePlotData}. 10 | #' 11 | #' @param L_A Logical: should splines be drawn with \code{line_antialias = 12 | #' TRUE}? 13 | #' 14 | #' @param \dots Parameters to be passed downstream. 15 | #' 16 | #' @return None. A spline is added to the 3D hive plot in progress. 17 | #' 18 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 19 | #' 20 | #' @seealso \code{\link{plot3dHive}} which calls this function and is the user 21 | #' interface. 22 | #' 23 | #' @keywords plot hplot 24 | #' 25 | #' @export drawHiveSpline 26 | #' 27 | #' @importFrom rgl lines3d 28 | #' 29 | drawHiveSpline <- function(HPD, L_A = FALSE, ...) { 30 | 31 | # Function to locate a 3d spline curve in a particular n dimensional 32 | # system & figure out the control point 33 | 34 | # For use with plot3dHive 35 | # Bryan Hanson, DePauw University, Feb 2011 and onward 36 | 37 | if (!requireNamespace("rgl", quietly = TRUE)) { 38 | stop("You need to install package rgl to use this function") 39 | } 40 | 41 | # The point pairs to be connected given by df edges 42 | 43 | chkHPD(HPD) 44 | nodes <- HPD$nodes 45 | edges <- HPD$edges 46 | nx <- length(unique(nodes$axis)) 47 | if ((nx == 2) | (nx == 3)) stop("You shouldn't be calling this function w/2 or 3 axes") 48 | 49 | ##### Get the edges data frame ready 50 | 51 | ax1 <- rad1 <- ax2 <- rad2 <- c() 52 | 53 | for (n in 1:nrow(edges)) { 54 | pat1 <- paste("\\b", edges$id1[n], "\\b", sep = "") 55 | pat2 <- paste("\\b", edges$id2[n], "\\b", sep = "") 56 | id1 <- grep(pat1, nodes$id) 57 | id2 <- grep(pat2, nodes$id) 58 | 59 | ax1 <- c(ax1, nodes$axis[id1]) 60 | rad1 <- c(rad1, nodes$radius[id1]) 61 | ax2 <- c(ax2, nodes$axis[id2]) 62 | rad2 <- c(rad2, nodes$radius[id2]) 63 | } 64 | 65 | ds <- data.frame(ax1, rad1, ax2, rad2) 66 | ds$phi1 <- ds$phi2 <- ds$th1 <- ds$th2 <- rep(NA, length(ds$ax1)) 67 | 68 | ##### 4D, This requires a 3D spline curve to be drawn 69 | 70 | if (nx == 4) { 71 | for (n in 1:nrow(ds)) { 72 | if (ds$ax1[n] == 1) { 73 | ds$phi1[n] <- 54.7 74 | ds$th1[n] <- 45 75 | } 76 | if (ds$ax1[n] == 2) { 77 | ds$phi1[n] <- 125.3 78 | ds$th1[n] <- -45 79 | } 80 | if (ds$ax1[n] == 3) { 81 | ds$phi1[n] <- 125.3 82 | ds$th1[n] <- 135 83 | } 84 | if (ds$ax1[n] == 4) { 85 | ds$phi1[n] <- 54.7 86 | ds$th1[n] <- -135 87 | } 88 | 89 | if (ds$ax2[n] == 1) { 90 | ds$phi2[n] <- 54.7 91 | ds$th2[n] <- 45 92 | } 93 | if (ds$ax2[n] == 2) { 94 | ds$phi2[n] <- 125.3 95 | ds$th2[n] <- -45 96 | } 97 | if (ds$ax2[n] == 3) { 98 | ds$phi2[n] <- 125.3 99 | ds$th2[n] <- 135 100 | } 101 | if (ds$ax2[n] == 4) { 102 | ds$phi2[n] <- 54.7 103 | ds$th2[n] <- -135 104 | } 105 | } 106 | 107 | pt1 <- data.frame(radius = ds$rad1, theta = ds$th1, phi = ds$phi1) 108 | pt2 <- data.frame(radius = ds$rad2, theta = ds$th2, phi = ds$phi2) 109 | pt1 <- sph2cart(pt1) 110 | pt2 <- sph2cart(pt2) 111 | 112 | # Compute control point, then create splines 113 | # Splines must be drawn one at a time (slow!) 114 | 115 | cp <- 0.6 * (pt1 + pt2) 116 | 117 | pt1 <- as.matrix(pt1) 118 | cp <- as.matrix(cp) 119 | pt2 <- as.matrix(pt2) 120 | 121 | for (n in 1:nrow(pt1)) { 122 | spl <- rcsr(p0 = pt1[n, ], cp = cp[n, ], p1 = pt2[n, ]) 123 | rgl::lines3d( 124 | x = spl[, 1], y = spl[, 2], z = spl[, 3], 125 | line_antialias = L_A, col = edges$color[n], lwd = edges$weight[n] 126 | ) 127 | } 128 | } # end of nx = 4 129 | 130 | ##### 5D, This requires a 3D spline curve to be drawn 131 | 132 | if (nx == 5) { 133 | for (n in 1:nrow(ds)) { 134 | if (ds$ax1[n] == 1) { 135 | ds$phi1[n] <- 90 136 | ds$th1[n] <- 0 137 | } 138 | if (ds$ax1[n] == 2) { 139 | ds$phi1[n] <- 90 140 | ds$th1[n] <- 120 141 | } 142 | if (ds$ax1[n] == 3) { 143 | ds$phi1[n] <- 90 144 | ds$th1[n] <- 240 145 | } 146 | if (ds$ax1[n] == 4) { 147 | ds$phi1[n] <- 0 148 | ds$th1[n] <- 0 149 | } 150 | if (ds$ax1[n] == 5) { 151 | ds$phi1[n] <- 180 152 | ds$th1[n] <- 0 153 | } 154 | 155 | if (ds$ax2[n] == 1) { 156 | ds$phi2[n] <- 90 157 | ds$th2[n] <- 0 158 | } 159 | if (ds$ax2[n] == 2) { 160 | ds$phi2[n] <- 90 161 | ds$th2[n] <- 120 162 | } 163 | if (ds$ax2[n] == 3) { 164 | ds$phi2[n] <- 90 165 | ds$th2[n] <- 240 166 | } 167 | if (ds$ax2[n] == 4) { 168 | ds$phi2[n] <- 0 169 | ds$th2[n] <- 0 170 | } 171 | if (ds$ax2[n] == 5) { 172 | ds$phi2[n] <- 180 173 | ds$th2[n] <- 0 174 | } 175 | } 176 | 177 | pt1 <- data.frame(radius = ds$rad1, theta = ds$th1, phi = ds$phi1) 178 | pt2 <- data.frame(radius = ds$rad2, theta = ds$th2, phi = ds$phi2) 179 | pt1 <- sph2cart(pt1) 180 | pt2 <- sph2cart(pt2) 181 | 182 | # Compute control point, then create splines 183 | # Splines must be drawn one at a time (slow!) 184 | 185 | cp <- 0.6 * (pt1 + pt2) 186 | 187 | pt1 <- as.matrix(pt1) 188 | cp <- as.matrix(cp) 189 | pt2 <- as.matrix(pt2) 190 | for (n in 1:nrow(pt1)) { 191 | spl <- rcsr(p0 = pt1[n, ], cp = cp[n, ], p1 = pt2[n, ]) 192 | rgl::lines3d( 193 | x = spl[, 1], y = spl[, 2], z = spl[, 3], 194 | line_antialias = L_A, col = edges$color[n], lwd = edges$weight[n] 195 | ) 196 | } 197 | } # end of nx = 5 198 | 199 | ##### 6D, This requires a 3D spline curve to be drawn 200 | 201 | if (nx == 6) { 202 | for (n in 1:nrow(ds)) { 203 | if (ds$ax1[n] == 1) { 204 | ds$phi1[n] <- 90 205 | ds$th1[n] <- 0 206 | } 207 | if (ds$ax1[n] == 2) { 208 | ds$phi1[n] <- 90 209 | ds$th1[n] <- 90 210 | } 211 | if (ds$ax1[n] == 3) { 212 | ds$phi1[n] <- 90 213 | ds$th1[n] <- 180 214 | } 215 | if (ds$ax1[n] == 4) { 216 | ds$phi1[n] <- 90 217 | ds$th1[n] <- 270 218 | } 219 | if (ds$ax1[n] == 5) { 220 | ds$phi1[n] <- 0 221 | ds$th1[n] <- 0 222 | } 223 | if (ds$ax1[n] == 6) { 224 | ds$phi1[n] <- 180 225 | ds$th1[n] <- 0 226 | } 227 | 228 | if (ds$ax2[n] == 1) { 229 | ds$phi2[n] <- 90 230 | ds$th2[n] <- 0 231 | } 232 | if (ds$ax2[n] == 2) { 233 | ds$phi2[n] <- 90 234 | ds$th2[n] <- 90 235 | } 236 | if (ds$ax2[n] == 3) { 237 | ds$phi2[n] <- 90 238 | ds$th2[n] <- 180 239 | } 240 | if (ds$ax2[n] == 4) { 241 | ds$phi2[n] <- 90 242 | ds$th2[n] <- 270 243 | } 244 | if (ds$ax2[n] == 5) { 245 | ds$phi2[n] <- 0 246 | ds$th2[n] <- 0 247 | } 248 | if (ds$ax2[n] == 6) { 249 | ds$phi2[n] <- 180 250 | ds$th2[n] <- 0 251 | } 252 | } 253 | 254 | pt1 <- data.frame(radius = ds$rad1, theta = ds$th1, phi = ds$phi1) 255 | pt2 <- data.frame(radius = ds$rad2, theta = ds$th2, phi = ds$phi2) 256 | pt1 <- sph2cart(pt1) 257 | pt2 <- sph2cart(pt2) 258 | 259 | # Compute control point, then create splines 260 | # Splines must be drawn one at a time (slow!) 261 | 262 | cp <- 0.6 * (pt1 + pt2) 263 | 264 | pt1 <- as.matrix(pt1) 265 | cp <- as.matrix(cp) 266 | pt2 <- as.matrix(pt2) 267 | for (n in 1:nrow(pt1)) { 268 | spl <- rcsr(p0 = pt1[n, ], cp = cp[n, ], p1 = pt2[n, ]) 269 | rgl::lines3d( 270 | x = spl[, 1], y = spl[, 2], z = spl[, 3], 271 | line_antialias = L_A, col = edges$color[n], lwd = edges$weight[n] 272 | ) 273 | } 274 | } # end of nx = 6 275 | } # closing brace, this is the very end! 276 | -------------------------------------------------------------------------------- /R/edge2HPD.R: -------------------------------------------------------------------------------- 1 | #' Process an Edge List into a Hive Plot Data Object 2 | #' 3 | #' This function will take an edge list and convert it into a basic 4 | #' \code{\link{HivePlotData}} object. Further manipulation by 5 | #' \code{\link{mineHPD}} will almost certainly be required before the data can 6 | #' be plotted. 7 | #' 8 | #' This function produces a "bare bones" \code{HivePlotData} object. The user 9 | #' will likely have to make some changes manually to the resulting 10 | #' \code{HivePlotData} object before plotting. Alternatively, 11 | #' \code{\link{mineHPD}} may be able to extract some information buried in the 12 | #' data, but even then, the user might need to make some adjustments. See the 13 | #' examples. 14 | #' 15 | #' @param edge_df A data frame containing edge list information. Columns should 16 | #' be node1, node2, edge weight (column names are arbitrary). Edge weight 17 | #' information is optional. If missing, edge weights will be set to 1. 18 | #' 19 | #' @param axis.cols A character vector giving the colors desired for the axes. 20 | #' 21 | #' @param type One of \code{c("2D", "3D")}. If \code{2D}, a 22 | #' \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 23 | #' be created and the eventual hive plot will be static and 2D. If \code{3D}, 24 | #' the \code{HivePlotData} object will be suitable for a 3D interactive plot 25 | #' using \code{\link{plot3dHive}}. 26 | #' 27 | #' @param desc Character. A description of the data set. 28 | #' 29 | #' @param \dots Other parameters to be passed downstream. 30 | #' 31 | #' @return A \code{\link{HivePlotData}} object. 32 | #' 33 | #' @author Jonathan H. Chung, with minor changes for consistency by Bryan A. 34 | #' Hanson. 35 | #' 36 | #' @seealso \code{\link{dot2HPD}} and \code{\link{adj2HPD}} 37 | #' 38 | #' @keywords utilities 39 | #' 40 | #' @export edge2HPD 41 | #' 42 | #' @examples 43 | #' 44 | #' # Create a simple edge list & process it 45 | #' edges <- data.frame( 46 | #' lab1 = LETTERS[c(1:8, 7)], 47 | #' lab2 = LETTERS[c(2:4, 1:3, 4, 2, 2)], 48 | #' weight = c(1, 1, 2, 2, 3, 1, 2, 3, 1) 49 | #' ) 50 | #' 51 | #' td <- edge2HPD(edge_df = edges, desc = "Test of edge2HPD") 52 | #' td.out <- sumHPD(td, plot.list = TRUE) 53 | #' # compare: 54 | #' edges 55 | #' td.out[, c(3, 7, 8)] 56 | edge2HPD <- function(edge_df = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) { 57 | 58 | # Authored and contributed to HiveR by Jonathan H. Chung, June 2013. 59 | # Thanks Jon. Some changes for consistency by Bryan A. Hanson 60 | # A few boo-boos caught by Vesna Memisevic 61 | 62 | if (is.null(edge_df)) { 63 | stop("No edge data provided") 64 | } 65 | if (!is.data.frame(edge_df)) { 66 | stop("edge_df is not a data frame") 67 | } 68 | 69 | ### Process nodes 70 | # Get node labels 71 | lab1 <- unlist(edge_df[, 1]) 72 | lab1 <- as.character(lab1) 73 | lab2 <- unlist(edge_df[, 2]) 74 | lab2 <- as.character(lab2) 75 | 76 | # Get number of unique nodes 77 | nn <- length(unique(c(lab1, lab2))) 78 | 79 | # Set default node size to 1 80 | size <- rep(1, nn) 81 | # Create a vector for node ID 82 | id <- 1:nn 83 | 84 | # Assign default axis 85 | axis <- rep(1, nn) 86 | # Assign node color 87 | color <- as.character(rep("black", nn)) 88 | # Assign radius 89 | radius <- rep(1, nn) 90 | 91 | # Create empty HPD object 92 | HPD <- list() 93 | 94 | # Assemble node attributes 95 | HPD$nodes$id <- id 96 | HPD$nodes$lab <- unique(c(lab1, lab2)) 97 | HPD$nodes$axis <- axis 98 | HPD$nodes$radius <- radius 99 | HPD$nodes$size <- size 100 | HPD$nodes$color <- color 101 | 102 | ### Process edges - a bit tricky to coordinate! 103 | ne <- nrow(edge_df) 104 | edge_df[, 1] <- as.character(edge_df[, 1]) # for use as id 105 | edge_df[, 2] <- as.character(edge_df[, 2]) # may read in as integers 106 | HPD$edges$id1 <- rep(NA, ne) 107 | HPD$edges$id2 <- rep(NA, ne) 108 | 109 | for (n in 1:ne) { # same logic as over in dot2HPD 110 | pat1 <- paste("\\b", edge_df[n, 1], "\\b", sep = "") # need word boundaries 111 | # print(pat1) 112 | pat2 <- paste("\\b", edge_df[n, 2], "\\b", sep = "") # to avoid finding fragments 113 | HPD$edges$id1[n] <- grep(pat1, HPD$nodes$lab) 114 | HPD$edges$id2[n] <- grep(pat2, HPD$nodes$lab) 115 | } 116 | 117 | # check if edge data has weights in col 3 118 | if (ncol(edge_df) > 2) { 119 | if (is.numeric(edge_df[, 3]) | is.integer(edge_df[, 3])) { 120 | edge_weight <- edge_df[, 3] 121 | } else { 122 | warning("No edge weight column detected. Setting default edge weight to 1") 123 | edge_weight <- rep(1, ne) 124 | } 125 | } 126 | 127 | HPD$edges$weight <- edge_weight 128 | HPD$edges$color <- rep("gray", ne) 129 | HPD$nodes <- as.data.frame(HPD$nodes) 130 | HPD$edges <- as.data.frame(HPD$edges) 131 | 132 | # Add description 133 | if (is.null(desc)) { 134 | desc <- "No description provided" 135 | } 136 | HPD$desc <- desc 137 | 138 | # Define axis columns 139 | if (is.null(axis.cols)) { 140 | axis.cols <- brewer.pal(length(unique(HPD$nodes$axis)), "Set1") 141 | } 142 | HPD$axis.cols <- axis.cols 143 | 144 | # Clean up HPD object 145 | HPD$nodes$axis <- as.integer(HPD$nodes$axis) 146 | HPD$nodes$size <- as.numeric(HPD$nodes$size) 147 | HPD$nodes$color <- as.character(HPD$nodes$color) 148 | HPD$nodes$lab <- as.character(HPD$nodes$lab) 149 | HPD$nodes$id <- as.integer(HPD$nodes$id) 150 | HPD$edges$id1 <- as.integer(HPD$edges$id1) 151 | HPD$edges$id2 <- as.integer(HPD$edges$id2) 152 | HPD$edges$weight <- as.numeric(HPD$edges$weight) 153 | HPD$edges$color <- as.character(HPD$edges$color) 154 | HPD$type <- type 155 | class(HPD) <- "HivePlotData" 156 | 157 | # Check HPD object 158 | chkHPD(HPD) 159 | return(HPD) 160 | } 161 | -------------------------------------------------------------------------------- /R/manipAxis.R: -------------------------------------------------------------------------------- 1 | #' Modify the Display of Axes and Nodes in a Hive Plot 2 | #' 3 | #' This function modifies various aspects of a \code{HivePlotData} object. A 4 | #' typical use is to convert the radii from the native/absolute values in the 5 | #' original object to either a normalized value (0\ldots{}1) or to a ranked 6 | #' value. The order of nodes on an axis can also be inverted, and an axis can 7 | #' be pruned (removed) from the \code{HivePlotData} object. 8 | #' 9 | #' The rank method uses \code{ties.method = "first"} so that each node gets a 10 | #' unique radius. For pruning, the nodes and edges are removed and then the 11 | #' remaining axes are renumbered to start from one. Exercise caution! 12 | #' 13 | #' For \code{"scale"} node radii will be multiplied by the corresponding value 14 | #' in this argument. For \code{"invert"} a value of -1 will cause the 15 | #' corresponding axis to be inverted. For \code{"prune"}, a single value 16 | #' specifying the axis to be pruned should be given. For \code{"offset"} the 17 | #' values in \code{"action"} will be subtracted from the node radii. For 18 | #' \code{"stretch"}, node radii will first be offset so that the minimum value 19 | #' is zero, then multiplied by the values in \code{"action"} to stretch the 20 | #' axis. Depending upon the desired effect, one might use \code{"stretch"} 21 | #' followed by \code{"offset"} or perhaps other combinations. 22 | #' 23 | #' @param HPD An object of S3 class \code{HivePlotData}. 24 | #' 25 | #' @param method One of \code{c("rank", "norm", "scale", "invert", "ranknorm", 26 | #' "prune", "offset", "stretch")} giving the type of modification to be made. 27 | #' 28 | #' @param action For \code{method = c("scale", "invert", "offset", "stretch")}, 29 | #' a numeric vector of the same length as the number of axes. 30 | #' 31 | #' @param ... Arguments to be passed downstream. Needed in this case for when 32 | #' \code{plotHive} has arguments for \code{grid} that get laundered through 33 | #' \code{manipAxis} 34 | #' 35 | #' @return A modified \code{HivePlotData} object. 36 | #' 37 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 38 | #' 39 | #' @keywords utilities 40 | #' 41 | #' @export manipAxis 42 | #' 43 | #' @examples 44 | #' 45 | #' data(HEC) 46 | #' # The first 3 examples take advantage of the argument '...' 47 | #' # in plotHive, which passes action through to manipAxis on the fly. 48 | #' # For this particular data, norm and absolute scaling appear the same. 49 | #' 50 | #' plotHive(HEC, bkgnd = "white") # default is absolute positioning of nodes 51 | #' plotHive(HEC, method = "rank", bkgnd = "white") 52 | #' plotHive(HEC, method = "norm", bkgnd = "white") 53 | #' 54 | #' # In these examples, we'll explicitly use manipAxis and then plot 55 | #' # in a separate step. This is because trying to plot on the fly in 56 | #' # these cases will result in absolute scaling (which we do use here, 57 | #' # but one might not want to be forced to do so). 58 | #' 59 | #' HEC2 <- manipAxis(HEC, method = "invert", action = c(-1, 1)) 60 | #' plotHive(HEC2, bkgnd = "white") 61 | #' HEC3 <- manipAxis(HEC, method = "stretch", action = c(2, 3)) 62 | #' plotHive(HEC3, bkgnd = "white") 63 | #' HEC4 <- manipAxis(HEC, method = "offset", action = c(0, 1.5)) 64 | #' plotHive(HEC4, bkgnd = "white") 65 | manipAxis <- function(HPD, method, action = NULL, ...) { 66 | 67 | # Function to rank or norm a Hive Plot Object 68 | # Part of Hive3dR 69 | # Bryan Hanson, DePauw Univ, July 2011 onward 70 | 71 | # Check for valid option 72 | 73 | if (!method %in% c( 74 | "rank", "norm", "invert", "scale", "prune", "ranknorm", 75 | "offset", "stretch" 76 | )) { 77 | stop("Unrecognized method") 78 | } 79 | 80 | chkHPD(HPD) 81 | nodes <- HPD[[1]] 82 | nx <- length(unique(nodes$axis)) 83 | 84 | if (nx == 2) { 85 | n1 <- which(nodes$axis == 1) 86 | n2 <- which(nodes$axis == 2) 87 | } 88 | 89 | if (nx == 3) { 90 | n1 <- which(nodes$axis == 1) 91 | n2 <- which(nodes$axis == 2) 92 | n3 <- which(nodes$axis == 3) 93 | } 94 | 95 | if (nx == 4) { 96 | n1 <- which(nodes$axis == 1) 97 | n2 <- which(nodes$axis == 2) 98 | n3 <- which(nodes$axis == 3) 99 | n4 <- which(nodes$axis == 4) 100 | } 101 | 102 | if (nx == 5) { 103 | n1 <- which(nodes$axis == 1) 104 | n2 <- which(nodes$axis == 2) 105 | n3 <- which(nodes$axis == 3) 106 | n4 <- which(nodes$axis == 4) 107 | n5 <- which(nodes$axis == 5) 108 | } 109 | 110 | if (nx == 6) { 111 | n1 <- which(nodes$axis == 1) 112 | n2 <- which(nodes$axis == 2) 113 | n3 <- which(nodes$axis == 3) 114 | n4 <- which(nodes$axis == 4) 115 | n5 <- which(nodes$axis == 5) 116 | n6 <- which(nodes$axis == 6) 117 | } 118 | 119 | if (method == "rank") { 120 | if (nx == 2) { 121 | nodes$radius[n1] <- rank(nodes$radius[n1], ties.method = "first") 122 | nodes$radius[n2] <- rank(nodes$radius[n2], ties.method = "first") 123 | } 124 | 125 | if (nx == 3) { 126 | nodes$radius[n1] <- rank(nodes$radius[n1], ties.method = "first") 127 | nodes$radius[n2] <- rank(nodes$radius[n2], ties.method = "first") 128 | nodes$radius[n3] <- rank(nodes$radius[n3], ties.method = "first") 129 | } 130 | 131 | if (nx == 4) { 132 | nodes$radius[n1] <- rank(nodes$radius[n1], ties.method = "first") 133 | nodes$radius[n2] <- rank(nodes$radius[n2], ties.method = "first") 134 | nodes$radius[n3] <- rank(nodes$radius[n3], ties.method = "first") 135 | nodes$radius[n4] <- rank(nodes$radius[n4], ties.method = "first") 136 | } 137 | 138 | if (nx == 5) { 139 | nodes$radius[n1] <- rank(nodes$radius[n1], ties.method = "first") 140 | nodes$radius[n2] <- rank(nodes$radius[n2], ties.method = "first") 141 | nodes$radius[n3] <- rank(nodes$radius[n3], ties.method = "first") 142 | nodes$radius[n4] <- rank(nodes$radius[n4], ties.method = "first") 143 | nodes$radius[n5] <- rank(nodes$radius[n5], ties.method = "first") 144 | } 145 | 146 | if (nx == 6) { 147 | nodes$radius[n1] <- rank(nodes$radius[n1], ties.method = "first") 148 | nodes$radius[n2] <- rank(nodes$radius[n2], ties.method = "first") 149 | nodes$radius[n3] <- rank(nodes$radius[n3], ties.method = "first") 150 | nodes$radius[n4] <- rank(nodes$radius[n4], ties.method = "first") 151 | nodes$radius[n5] <- rank(nodes$radius[n5], ties.method = "first") 152 | nodes$radius[n6] <- rank(nodes$radius[n6], ties.method = "first") 153 | } 154 | } # end of method == "rank" 155 | 156 | if (method == "norm") { 157 | if (nx == 2) { 158 | min1 <- min(nodes$radius[n1]) 159 | max1 <- max(nodes$radius[n1]) 160 | min2 <- min(nodes$radius[n2]) 161 | max2 <- max(nodes$radius[n2]) 162 | 163 | nodes$radius[n1] <- (nodes$radius[n1] - min1) / (max1 - min1) 164 | nodes$radius[n2] <- (nodes$radius[n2] - min2) / (max2 - min2) 165 | } 166 | 167 | if (nx == 3) { 168 | min1 <- min(nodes$radius[n1]) 169 | max1 <- max(nodes$radius[n1]) 170 | min2 <- min(nodes$radius[n2]) 171 | max2 <- max(nodes$radius[n2]) 172 | min3 <- min(nodes$radius[n3]) 173 | max3 <- max(nodes$radius[n3]) 174 | 175 | nodes$radius[n1] <- (nodes$radius[n1] - min1) / (max1 - min1) 176 | nodes$radius[n2] <- (nodes$radius[n2] - min2) / (max2 - min2) 177 | nodes$radius[n3] <- (nodes$radius[n3] - min3) / (max3 - min3) 178 | } 179 | 180 | if (nx == 4) { 181 | min1 <- min(nodes$radius[n1]) 182 | max1 <- max(nodes$radius[n1]) 183 | min2 <- min(nodes$radius[n2]) 184 | max2 <- max(nodes$radius[n2]) 185 | min3 <- min(nodes$radius[n3]) 186 | max3 <- max(nodes$radius[n3]) 187 | min4 <- min(nodes$radius[n4]) 188 | max4 <- max(nodes$radius[n4]) 189 | 190 | nodes$radius[n1] <- (nodes$radius[n1] - min1) / (max1 - min1) 191 | nodes$radius[n2] <- (nodes$radius[n2] - min2) / (max2 - min2) 192 | nodes$radius[n3] <- (nodes$radius[n3] - min3) / (max3 - min3) 193 | nodes$radius[n4] <- (nodes$radius[n4] - min4) / (max4 - min4) 194 | } 195 | 196 | if (nx == 5) { 197 | min1 <- min(nodes$radius[n1]) 198 | max1 <- max(nodes$radius[n1]) 199 | min2 <- min(nodes$radius[n2]) 200 | max2 <- max(nodes$radius[n2]) 201 | min3 <- min(nodes$radius[n3]) 202 | max3 <- max(nodes$radius[n3]) 203 | min4 <- min(nodes$radius[n4]) 204 | max4 <- max(nodes$radius[n4]) 205 | min5 <- min(nodes$radius[n5]) 206 | max5 <- max(nodes$radius[n5]) 207 | 208 | nodes$radius[n1] <- (nodes$radius[n1] - min1) / (max1 - min1) 209 | nodes$radius[n2] <- (nodes$radius[n2] - min2) / (max2 - min2) 210 | nodes$radius[n3] <- (nodes$radius[n3] - min3) / (max3 - min3) 211 | nodes$radius[n4] <- (nodes$radius[n4] - min4) / (max4 - min4) 212 | nodes$radius[n5] <- (nodes$radius[n5] - min5) / (max5 - min5) 213 | } 214 | 215 | if (nx == 6) { 216 | min1 <- min(nodes$radius[n1]) 217 | max1 <- max(nodes$radius[n1]) 218 | min2 <- min(nodes$radius[n2]) 219 | max2 <- max(nodes$radius[n2]) 220 | min3 <- min(nodes$radius[n3]) 221 | max3 <- max(nodes$radius[n3]) 222 | min4 <- min(nodes$radius[n4]) 223 | max4 <- max(nodes$radius[n4]) 224 | min5 <- min(nodes$radius[n5]) 225 | max5 <- max(nodes$radius[n5]) 226 | min6 <- min(nodes$radius[n6]) 227 | max6 <- max(nodes$radius[n6]) 228 | 229 | nodes$radius[n1] <- (nodes$radius[n1] - min1) / (max1 - min1) 230 | nodes$radius[n2] <- (nodes$radius[n2] - min2) / (max2 - min2) 231 | nodes$radius[n3] <- (nodes$radius[n3] - min3) / (max3 - min3) 232 | nodes$radius[n4] <- (nodes$radius[n4] - min4) / (max4 - min4) 233 | nodes$radius[n5] <- (nodes$radius[n5] - min5) / (max5 - min5) 234 | nodes$radius[n6] <- (nodes$radius[n6] - min6) / (max6 - min6) 235 | } 236 | } # end of method == "norm" 237 | 238 | if (method == "scale") { 239 | if (is.null(action)) stop("You must supply action") 240 | if (!length(action) == length(unique(nodes$axis))) stop("length(action) did not match no. axes") 241 | 242 | if (nx == 2) { 243 | nodes$radius[n1] <- nodes$radius[n1] * action[1] 244 | nodes$radius[n2] <- nodes$radius[n2] * action[2] 245 | } 246 | 247 | if (nx == 3) { 248 | nodes$radius[n1] <- nodes$radius[n1] * action[1] 249 | nodes$radius[n2] <- nodes$radius[n2] * action[2] 250 | nodes$radius[n3] <- nodes$radius[n3] * action[3] 251 | } 252 | 253 | if (nx == 4) { 254 | nodes$radius[n1] <- nodes$radius[n1] * action[1] 255 | nodes$radius[n2] <- nodes$radius[n2] * action[2] 256 | nodes$radius[n3] <- nodes$radius[n3] * action[3] 257 | nodes$radius[n4] <- nodes$radius[n4] * action[4] 258 | } 259 | 260 | if (nx == 5) { 261 | nodes$radius[n1] <- nodes$radius[n1] * action[1] 262 | nodes$radius[n2] <- nodes$radius[n2] * action[2] 263 | nodes$radius[n3] <- nodes$radius[n3] * action[3] 264 | nodes$radius[n4] <- nodes$radius[n4] * action[4] 265 | nodes$radius[n5] <- nodes$radius[n5] * action[5] 266 | } 267 | 268 | if (nx == 6) { 269 | nodes$radius[n1] <- nodes$radius[n1] * action[1] 270 | nodes$radius[n2] <- nodes$radius[n2] * action[2] 271 | nodes$radius[n3] <- nodes$radius[n3] * action[3] 272 | nodes$radius[n4] <- nodes$radius[n4] * action[4] 273 | nodes$radius[n5] <- nodes$radius[n5] * action[5] 274 | nodes$radius[n6] <- nodes$radius[n6] * action[6] 275 | } 276 | } # end of method == "scale" 277 | 278 | if (method == "invert") { 279 | if (is.null(action)) stop("You must supply action") 280 | if (!length(action) == length(unique(nodes$axis))) stop("length(action) did not match no. axes") 281 | 282 | for (n in 1:length(action)) { 283 | if (action[n] == -1) { 284 | xx <- which(nodes$axis == n) 285 | nodes$radius[xx] <- nodes$radius[xx] * -1 + min(nodes$radius[xx]) * 2 + diff(range(nodes$radius[xx])) 286 | } 287 | } 288 | } # end of method == "invert" 289 | 290 | if (method == "prune") { 291 | if (is.null(action)) stop("You must supply action") 292 | if (!length(action) == 1) stop("Action must give only one axis to prune") 293 | if ((action > max(nodes$axis)) | (action < 1)) stop("Axis to prune is < 1 or > no. of axes") 294 | 295 | # rem <- subset(nodes, axis == action) 296 | # nodes <- subset(nodes, !axis == action) 297 | rem <- nodes[nodes[, "axis"] == action, ] 298 | nodes <- nodes[nodes[, "axis"] != action, ] 299 | 300 | if (action == 1) nodes$axis <- nodes$axis - 1L 301 | if (action == 2) { 302 | ch <- which(nodes$axis >= 3) 303 | nodes$axis[ch] <- nodes$axis[ch] - 1L 304 | } 305 | if (action == 3) { 306 | ch <- which(nodes$axis >= 4) 307 | nodes$axis[ch] <- nodes$axis[ch] - 1L 308 | } 309 | if (action == 4) { 310 | ch <- which(nodes$axis >= 5) 311 | nodes$axis[ch] <- nodes$axis[ch] - 1L 312 | } 313 | if (action == 5) { 314 | ch <- which(nodes$axis == 6) 315 | nodes$axis[ch] <- nodes$axis[ch] - 1L 316 | } # df nodes fixed! 317 | 318 | edges <- HPD$edges 319 | k1 <- !edges$id1 %in% rem$id 320 | edges <- edges[k1, ] 321 | k2 <- !edges$id2 %in% rem$id 322 | edges <- edges[k2, ] 323 | HPD[[2]] <- edges # prune is the only place edges are messed with 324 | } # end of method == "prune" 325 | 326 | if (method == "ranknorm") { # rank first, then norm 327 | 328 | HPD <- manipAxis(HPD, method = "rank") 329 | HPD <- manipAxis(HPD, method = "norm") 330 | nodes <- HPD$nodes 331 | } # end of method == "ranknorm" 332 | 333 | if (method == "offset") { 334 | if (is.null(action)) stop("You must supply action") 335 | if (!length(action) == length(unique(nodes$axis))) stop("length(action) did not match no. axes") 336 | 337 | if (nx == 2) { 338 | nodes$radius[n1] <- nodes$radius[n1] + action[1] 339 | nodes$radius[n2] <- nodes$radius[n2] + action[2] 340 | } 341 | 342 | if (nx == 3) { 343 | nodes$radius[n1] <- nodes$radius[n1] + action[1] 344 | nodes$radius[n2] <- nodes$radius[n2] + action[2] 345 | nodes$radius[n3] <- nodes$radius[n3] + action[3] 346 | } 347 | 348 | if (nx == 4) { 349 | nodes$radius[n1] <- nodes$radius[n1] + action[1] 350 | nodes$radius[n2] <- nodes$radius[n2] + action[2] 351 | nodes$radius[n3] <- nodes$radius[n3] + action[3] 352 | nodes$radius[n4] <- nodes$radius[n4] + action[4] 353 | } 354 | 355 | if (nx == 5) { 356 | nodes$radius[n1] <- nodes$radius[n1] + action[1] 357 | nodes$radius[n2] <- nodes$radius[n2] + action[2] 358 | nodes$radius[n3] <- nodes$radius[n3] + action[3] 359 | nodes$radius[n4] <- nodes$radius[n4] + action[4] 360 | nodes$radius[n5] <- nodes$radius[n5] + action[5] 361 | } 362 | 363 | if (nx == 6) { 364 | nodes$radius[n1] <- nodes$radius[n1] + action[1] 365 | nodes$radius[n2] <- nodes$radius[n2] + action[2] 366 | nodes$radius[n3] <- nodes$radius[n3] + action[3] 367 | nodes$radius[n4] <- nodes$radius[n4] + action[4] 368 | nodes$radius[n5] <- nodes$radius[n5] + action[5] 369 | nodes$radius[n6] <- nodes$radius[n6] + action[6] 370 | } 371 | } # end of method == "offset" 372 | 373 | if (method == "stretch") { 374 | if (is.null(action)) stop("You must supply action") 375 | if (!length(action) == length(unique(nodes$axis))) stop("length(action) did not match no. axes") 376 | 377 | # Get min of each axis & subtract 378 | if (nx == 2) { 379 | min1 <- min(nodes$radius[n1]) 380 | min2 <- min(nodes$radius[n2]) 381 | off <- c(min1, min2) * -1 382 | } 383 | 384 | if (nx == 3) { 385 | min1 <- min(nodes$radius[n1]) 386 | min2 <- min(nodes$radius[n2]) 387 | min3 <- min(nodes$radius[n3]) 388 | off <- c(min1, min2, min3) * -1 389 | } 390 | 391 | if (nx == 4) { 392 | min1 <- min(nodes$radius[n1]) 393 | min2 <- min(nodes$radius[n2]) 394 | min3 <- min(nodes$radius[n3]) 395 | min4 <- min(nodes$radius[n4]) 396 | off <- c(min1, min2, min3, min4) * -1 397 | } 398 | 399 | if (nx == 5) { 400 | min1 <- min(nodes$radius[n1]) 401 | min2 <- min(nodes$radius[n2]) 402 | min3 <- min(nodes$radius[n3]) 403 | min4 <- min(nodes$radius[n4]) 404 | min5 <- min(nodes$radius[n5]) 405 | off <- c(min1, min2, min3, min4, min5) * -1 406 | } 407 | 408 | if (nx == 6) { 409 | min1 <- min(nodes$radius[n1]) 410 | min2 <- min(nodes$radius[n2]) 411 | min3 <- min(nodes$radius[n3]) 412 | min4 <- min(nodes$radius[n4]) 413 | min5 <- min(nodes$radius[n5]) 414 | min6 <- min(nodes$radius[n6]) 415 | off <- c(min1, min2, min3, min4, min5, min6) * -1 416 | } 417 | 418 | HPD <- manipAxis(HPD, method = "offset", action = off) 419 | HPD <- manipAxis(HPD, method = "scale", action = action) 420 | nodes <- HPD$nodes 421 | } # end of method == "stretch" 422 | 423 | HPD[[1]] <- nodes 424 | chkHPD(HPD) 425 | HPD 426 | } 427 | -------------------------------------------------------------------------------- /R/mineHPD.R: -------------------------------------------------------------------------------- 1 | #' Examine (mine) a Hive Plot Data Object and Extract Information Contained 2 | #' Within It 3 | #' 4 | #' A \code{HivePlotData object}, especially one created fresh using 5 | #' \code{\link{dot2HPD}}, generally contains a lot of hidden information about 6 | #' the network described. This function can extract this hidden information. 7 | #' This function has \code{option}s which are quite specific as to what they 8 | #' do. The user can easily write new options and incorporate them. 9 | #' This function can be called multiple times 10 | #' using different options to gradually modify the \code{HivePlotData} object. 11 | #' 12 | #' \code{option = "rad <- tot.edge.count"} This option looks through the 13 | #' \code{HivePlotData} object and determines how many edges start or end on 14 | #' each node (the "degree"). This value is then assigned to the radius for 15 | #' that node. 16 | #' 17 | #' \code{option = "axis <- source.man.sink"} This option 18 | #' examines the nodes and corresponding edges in a \code{HivePlotData} object 19 | #' to determine if the node is a source, manager or sink. A source node only 20 | #' has outgoing edges. A sink node only has incoming edges. A manager has 21 | #' both. Hence, this option treats the \code{HivePlotData} object as if it 22 | #' were directed in that the first node of an edge in will be in 23 | #' \code{HPD$nodes$id1} and the second node of an edge will be in 24 | #' \code{HPD$nodes$id2}. As a result, this option produces a hive plot with 3 25 | #' axes (note: sources are on axis 1, sinks on axis 2, and managers on axis 3). 26 | #' This concept is similar to the idea of \code{\link[FuncMap]{FuncMap}} but 27 | #' the internals are quite different. See also \code{\link{dot2HPD}} for some 28 | #' details about processing .dot files in an agnostic fashion. 29 | #' 30 | #' \code{option = "remove orphans"} removes nodes that have degree zero (no 31 | #' incoming or outgoing edges). 32 | #' 33 | #' \code{option = "remove zero edge"} 34 | #' removes edges with length zero. Such edges cause an error because 35 | #' the spline cannot be drawn. This option combines the next two options. 36 | #' 37 | #' \code{option = "remove self edge"} removes edges that 38 | #' start and end on the same node. 39 | #' 40 | #' \code{option = "remove virtual edge"} removes virtual edges which are 41 | #' edges which involve different nodes but the nodes happen to be on the 42 | #' the same axis at the same radius. 43 | #' 44 | #' \code{option = "remove edges same axis"} removes edges which start and 45 | #' end on the same axis. 46 | #' 47 | #' @param HPD A \code{\link{HivePlotData}} object. 48 | #' 49 | #' @param option A character string giving the option desired. See Details for 50 | #' current options. 51 | #' 52 | #' @return A modified \code{HivePlotData} object. 53 | #' 54 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 55 | #' 56 | #' @seealso See the vignette for an example of using this function. Use 57 | #' \code{browseVignettes("HiveR")} to produce the vignette. 58 | #' 59 | #' @keywords utilities 60 | #' 61 | #' @export mineHPD 62 | #' 63 | mineHPD <- function(HPD, option = "rad <- tot.edge.count") { 64 | 65 | # Function to process HPD objects in various ways 66 | # to dig out additional hidden info. 67 | # dot2HPD can only use the attribute tags in the dot file. 68 | # However, the graph intrinsically contains additional info 69 | # which can be mapped into a Hive Plot 70 | # This function can dig that info out. 71 | # Additional methods are easily added to this function. 72 | 73 | # Bryan Hanson, DePauw Univ, July 2011 onward 74 | 75 | # Check for valid option 76 | 77 | curopts <- c( 78 | "rad <- tot.edge.count", 79 | "axis <- source.man.sink", 80 | "remove orphans", 81 | "remove virtual edge", 82 | "remove self edge", 83 | "remove zero edge", 84 | "remove edges same axis" 85 | ) 86 | 87 | if (!option %in% curopts) { 88 | message("Unrecognized option, select from:") 89 | print(curopts) 90 | # msg <- paste("Unrecognized option, select from", paste(curopts, collapse = ", "), sep = " ") 91 | stop("invalid option") 92 | } 93 | edges <- HPD$edges 94 | nodes <- HPD$nodes 95 | nn <- length(nodes$id) 96 | 97 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 98 | 99 | if (option == "rad <- tot.edge.count") { 100 | 101 | # This option assigns a radius value to a node 102 | # based upon the total number of edges in which the node participates. 103 | 104 | for (n in 1:nn) { 105 | pat <- paste("\\b", nodes$id[n], "\\b", sep = "") 106 | p <- length(grep(pat, edges$id1)) 107 | q <- length(grep(pat, edges$id2)) 108 | nodes$radius[n] <- p + q 109 | } 110 | } ##### end of option == "rad <- tot.edge.count" 111 | 112 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 113 | 114 | if (option == "axis <- source.man.sink") { 115 | 116 | # This option assigns a node to an axis 117 | # based upon whether it is a source, manager or sink 118 | # by examining the edges. 119 | # Note that this option assumes a directed 120 | # input graph, as a source node only has "outgoing" edges etc. 121 | # Thus all edges start at edges$id1 and end on edges$id2. 122 | 123 | # source = axis 1, manager = axis 3, sink = axis 2 124 | # Basic procedure is that a node only listed in 125 | # edges$id2 is a sink etc. 126 | # Do things affirmatively, not assuming a default: 127 | # Ensures that things are done correctly. 128 | 129 | # if (!length(unique(nodes$axis)) == 3) { 130 | # stop("This option requires 3 unique axes") 131 | # } 132 | 133 | done <- FALSE # a check to make sure all nodes get an axis 134 | 135 | for (n in 1:nn) { 136 | pat <- paste("\\b", nodes$id[n], "\\b", sep = "") 137 | id1 <- grep(pat, edges$id1) 138 | id2 <- grep(pat, edges$id2) 139 | 140 | if ((length(id1) == 0) & (length(id2) > 0)) { 141 | nodes$axis[n] <- 2 142 | done <- TRUE 143 | next 144 | } # these are sinks, as they only receive an edge 145 | 146 | # note that set operations below drop duplicate values 147 | 148 | if ((length(id1) > 0) & (length(id2) > 0)) { 149 | common <- union(id1, id2) 150 | source <- setdiff(id1, common) 151 | if (length(source) == 1) { 152 | nodes$axis[n] <- 1 153 | done <- TRUE 154 | next 155 | } # these are sources 156 | 157 | if (length(common) >= 1) { 158 | nodes$axis[n] <- 3 159 | done <- TRUE 160 | next 161 | } # these are managers 162 | } 163 | 164 | if (!done) { 165 | msg <- paste("node ", nodes$id[n], " was not assigned to an axis", sep = "") 166 | warning(msg) 167 | } # alert the user there was a problem 168 | } # end of loop inspecting nodes 169 | 170 | nodes$axis <- as.integer(nodes$axis) 171 | } ##### end of option == "axis <- source.man.sink 172 | 173 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 174 | 175 | if (option == "remove orphans") { 176 | 177 | # This option removes orphaned nodes (which have no edges) 178 | # Almost the same code as over in sumHPD 179 | 180 | e.ids <- union(HPD$edges$id1, HPD$edges$id2) 181 | n.ids <- HPD$nodes$id 182 | prob <- setdiff(n.ids, e.ids) 183 | prob <- match(prob, HPD$nodes$id) 184 | if (length(prob) == 0) cat("\n\t No orphaned nodes were found\n") 185 | if (length(prob) > 0) { 186 | cat("\n\t", length(prob), "orphaned nodes (degree = 0) were removed\n\n") 187 | nodes <- nodes[-prob, ] 188 | } 189 | } ##### end of option == "remove orphans" 190 | 191 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 192 | 193 | if (option == "remove self edge") { 194 | 195 | # This option removes edges which start and end on the same node 196 | # It re-uses code from sumHPD 197 | 198 | # Create a list of edges to be drawn 199 | 200 | n1.lab <- n1.rad <- n2.lab <- n2.rad <- n1.ax <- n2.ax <- c() 201 | 202 | for (n in 1:(length(HPD$edges$id1))) { 203 | pat1 <- HPD$edges$id1[n] 204 | pat2 <- HPD$edges$id2[n] 205 | pat1 <- paste("\\b", pat1, "\\b", sep = "") # ensures exact match 206 | pat2 <- paste("\\b", pat2, "\\b", sep = "") 207 | i1 <- grep(pat1, HPD$nodes$id) 208 | i2 <- grep(pat2, HPD$nodes$id) 209 | n1.lab <- c(n1.lab, HPD$nodes$lab[i1]) 210 | n2.lab <- c(n2.lab, HPD$nodes$lab[i2]) 211 | n1.rad <- c(n1.rad, HPD$nodes$radius[i1]) 212 | n2.rad <- c(n2.rad, HPD$nodes$radius[i2]) 213 | n1.ax <- c(n1.ax, HPD$nodes$axis[i1]) 214 | n2.ax <- c(n2.ax, HPD$nodes$axis[i2]) 215 | } 216 | 217 | fd <- data.frame( 218 | n1.id = HPD$edges$id1, 219 | n1.ax, 220 | n1.lab = as.character(n1.lab), # June 2017 221 | n1.rad, 222 | n2.id = HPD$edges$id2, 223 | n2.ax, 224 | n2.lab = as.character(n2.lab), # June 2017 225 | n2.rad, 226 | e.wt = HPD$edges$weight, 227 | e.col = HPD$edges$color, 228 | stringsAsFactors = FALSE 229 | ) 230 | 231 | bad <- NA_integer_ 232 | 233 | prob <- which(fd$n1.lab == fd$n2.lab) 234 | if (length(prob) == 0) cat("\n\t No edges were found that start and end on the same node\n") 235 | if (length(prob) > 0) { 236 | for (n in 1:(length(HPD$edges$id1))) { 237 | pat1 <- HPD$edges$id1[n] 238 | pat2 <- HPD$edges$id2[n] 239 | if (pat1 == pat2) bad <- c(bad, n) 240 | } 241 | 242 | cat("\n\t", length(na.omit(bad)), "edge(s) that start and end on the same node were removed\n") 243 | } 244 | 245 | # Now actually remove the edges 246 | 247 | bad <- unique(na.omit(bad)) 248 | edges <- edges[-bad, ] 249 | } ##### end of option == "remove self edge" 250 | 251 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 252 | 253 | if (option == "remove edges same axis") { 254 | 255 | # This option removes edges which start and end on the same axis 256 | 257 | # Create a list of edges to be drawn 258 | 259 | n1.lab <- n1.rad <- n2.lab <- n2.rad <- n1.ax <- n2.ax <- edge.no <- c() 260 | 261 | for (n in 1:(length(HPD$edges$id1))) { 262 | pat1 <- HPD$edges$id1[n] 263 | pat2 <- HPD$edges$id2[n] 264 | pat1 <- paste("\\b", pat1, "\\b", sep = "") # ensures exact match 265 | pat2 <- paste("\\b", pat2, "\\b", sep = "") 266 | i1 <- grep(pat1, HPD$nodes$id) 267 | i2 <- grep(pat2, HPD$nodes$id) 268 | n1.lab <- c(n1.lab, HPD$nodes$lab[i1]) 269 | n2.lab <- c(n2.lab, HPD$nodes$lab[i2]) 270 | n1.rad <- c(n1.rad, HPD$nodes$radius[i1]) 271 | n2.rad <- c(n2.rad, HPD$nodes$radius[i2]) 272 | n1.ax <- c(n1.ax, HPD$nodes$axis[i1]) 273 | n2.ax <- c(n2.ax, HPD$nodes$axis[i2]) 274 | edge.no <- c(edge.no, n) # Jan 2019 for this method in particular 275 | } 276 | 277 | fd <- data.frame( 278 | n1.id = HPD$edges$id1, 279 | n1.ax, 280 | n1.lab = as.character(n1.lab), # June 2017 281 | n1.rad, 282 | n2.id = HPD$edges$id2, 283 | n2.ax, 284 | n2.lab = as.character(n2.lab), # June 2017 285 | n2.rad, 286 | edge.no = edge.no, 287 | e.wt = HPD$edges$weight, 288 | e.col = HPD$edges$color, 289 | stringsAsFactors = FALSE 290 | ) 291 | 292 | prob <- which(fd$n1.ax == fd$n2.ax) 293 | if (length(prob) == 0) cat("\n\t No edges were found that start and end on the same axis\n") 294 | if (length(prob) > 0) { 295 | bad <- fd$edge.no[prob] 296 | edges <- edges[-bad, ] 297 | cat("\n\t", length(na.omit(bad)), "edge(s) that start and end on the same axis were removed\n") 298 | } 299 | } ##### end of option == "remove edges same axis" 300 | 301 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 302 | 303 | if (option == "remove virtual edge") { 304 | 305 | # This option removes edges which start and end on the same 306 | # axis at the same radius. It reuses code from sumHPD 307 | 308 | # Create a list of edges to be drawn 309 | 310 | n1.lab <- n1.rad <- n2.lab <- n2.rad <- n1.ax <- n2.ax <- c() 311 | 312 | for (n in 1:(length(HPD$edges$id1))) { 313 | pat1 <- HPD$edges$id1[n] 314 | pat2 <- HPD$edges$id2[n] 315 | pat1 <- paste("\\b", pat1, "\\b", sep = "") # ensures exact match 316 | pat2 <- paste("\\b", pat2, "\\b", sep = "") 317 | i1 <- grep(pat1, HPD$nodes$id) 318 | i2 <- grep(pat2, HPD$nodes$id) 319 | n1.lab <- c(n1.lab, HPD$nodes$lab[i1]) 320 | n2.lab <- c(n2.lab, HPD$nodes$lab[i2]) 321 | n1.rad <- c(n1.rad, HPD$nodes$radius[i1]) 322 | n2.rad <- c(n2.rad, HPD$nodes$radius[i2]) 323 | n1.ax <- c(n1.ax, HPD$nodes$axis[i1]) 324 | n2.ax <- c(n2.ax, HPD$nodes$axis[i2]) 325 | } 326 | 327 | fd <- data.frame( 328 | n1.id = HPD$edges$id1, 329 | n1.ax, 330 | n1.lab = as.character(n1.lab), # June 2017 331 | n1.rad, 332 | n2.id = HPD$edges$id2, 333 | n2.ax, 334 | n2.lab = as.character(n2.lab), # June 2017 335 | n2.rad, 336 | e.wt = HPD$edges$weight, 337 | e.col = HPD$edges$color, 338 | stringsAsFactors = FALSE 339 | ) 340 | 341 | bad <- NA_integer_ 342 | prob1 <- which((fd$n1.rad == fd$n2.rad) & (fd$n1.ax == fd$n2.ax)) 343 | prob2 <- which(fd$n1.id == fd$n2.id) # omit true self edges 344 | prob <- setdiff(prob1, prob2) 345 | 346 | if (length(prob) == 0) cat("\n\t No virtual self-edges were found\n") 347 | if (length(prob) > 0) { 348 | virtProb <- data.frame(id1 = fd$n1.id[prob], id2 = fd$n2.id[prob]) 349 | for (i in 1:nrow(virtProb)) { 350 | for (j in 1:(length(HPD$edges$id1))) { 351 | if ((HPD$edges$id1[j] == virtProb[i, 1]) & (HPD$edges$id2[j] == virtProb[i, 2])) bad <- c(bad, j) 352 | if ((HPD$edges$id1[j] == virtProb[i, 2]) & (HPD$edges$id2[j] == virtProb[i, 1])) bad <- c(bad, j) 353 | } 354 | } 355 | cat("\n\t", length(na.omit(bad)), "virtual self-edge(s) were removed\n") 356 | } 357 | 358 | # Now actually remove the edges 359 | 360 | bad <- unique(na.omit(bad)) 361 | edges <- edges[-bad, ] 362 | } ##### end of option == "remove virtual edge" 363 | 364 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 365 | 366 | if (option == "remove zero edge") { 367 | 368 | # This option runs the two above 369 | HPD <- mineHPD(HPD, option = "remove self edge") 370 | HPD <- mineHPD(HPD, option = "remove virtual edge") 371 | return(HPD) 372 | } ##### end of option == "remove zero edge" 373 | 374 | ### ++++++++++++++++++++++++++++++++++++++++++++++++++++ ### 375 | 376 | # Final assembly and checking... 377 | 378 | HPD$edges <- edges 379 | HPD$nodes <- nodes 380 | chkHPD(HPD) 381 | HPD 382 | } 383 | -------------------------------------------------------------------------------- /R/plot3dHive.R: -------------------------------------------------------------------------------- 1 | #' 2 | #' @describeIn plotHive Create a 3D Hive Plot 3 | #' 4 | #' @importFrom rgl bg3d spheres3d text3d 5 | #' 6 | #' @export 7 | 8 | plot3dHive <- function(HPD, ch = 1, dr.nodes = TRUE, 9 | method = "abs", axLabs = NULL, axLab.pos = NULL, 10 | LA = FALSE, ...) { 11 | if (!requireNamespace("rgl", quietly = TRUE)) { 12 | stop("You need to install package rgl to use this function") 13 | } 14 | 15 | # Function to plot 3D hive plots 16 | # inspired by the work of Martin Kryzwinski 17 | # Bryan Hanson, DePauw Univ, Feb 2011 onward 18 | 19 | # Spherical coordinates will be used 20 | 21 | chkHPD(HPD) 22 | 23 | nx <- length(unique(HPD$nodes$axis)) 24 | if (nx == 1) stop("Something is wrong: only one axis seems to be present") 25 | if ((nx == 2) | (nx == 3)) stop("Use plotHive for hive plots with 2 or 3 axes") 26 | if (HPD$type == "2D") stop("Use plotHive for hive plots of type = 2D") 27 | 28 | # Send out for ranking/norming if requested 29 | 30 | if (!method == "abs") HPD <- manipAxis(HPD, method) 31 | 32 | nodes <- HPD$nodes 33 | edges <- HPD$edges 34 | axis.cols <- HPD$axis.cols 35 | 36 | nodes$radius <- nodes$radius + ch 37 | HPD$nodes$radius <- nodes$radius # important, as HPD is passed 38 | # to drawHiveSpline so it must be updated here 39 | 40 | rgl::bg3d("black") # black background to rgl graphics 41 | 42 | ##### Four dimensional case (nx = 4, 5, 6 with rgl graphics) 43 | 44 | # Draw axes first 45 | 46 | if (nx == 4) { 47 | 48 | # n1 <- subset(nodes, axis == 1) 49 | # n2 <- subset(nodes, axis == 2) 50 | # n3 <- subset(nodes, axis == 3) 51 | # n4 <- subset(nodes, axis == 4) 52 | 53 | n1 <- nodes[nodes[, "axis"] == 1, ] 54 | n2 <- nodes[nodes[, "axis"] == 2, ] 55 | n3 <- nodes[nodes[, "axis"] == 3, ] 56 | n4 <- nodes[nodes[, "axis"] == 4, ] 57 | 58 | max1 <- max(n1$radius) 59 | max2 <- max(n2$radius) 60 | max3 <- max(n3$radius) 61 | max4 <- max(n4$radius) 62 | min1 <- min(n1$radius) 63 | min2 <- min(n2$radius) 64 | min3 <- min(n3$radius) 65 | min4 <- min(n4$radius) 66 | 67 | r <- c(min1, max1, min2, max2, min3, max3, min4, max4) # in polar coordinates 68 | theta <- c(45, 45, -45, -45, 135, 135, -135, -135) # start, end, start, end 69 | phi <- c(54.7, 54.7, 125.3, 125.3, 125.3, 125.3, 54.7, 54.7) 70 | ax.df <- data.frame(radius = r, theta = theta, phi = phi) 71 | ax.coord <- sph2cart(ax.df) 72 | rgl::segments3d(ax.coord[1:2, ], col = axis.cols[1], line_antialias = TRUE, lwd = 4) 73 | rgl::segments3d(ax.coord[3:4, ], col = axis.cols[2], line_antialias = TRUE, lwd = 4) 74 | rgl::segments3d(ax.coord[5:6, ], col = axis.cols[3], line_antialias = TRUE, lwd = 4) 75 | rgl::segments3d(ax.coord[7:8, ], col = axis.cols[4], line_antialias = TRUE, lwd = 4) 76 | 77 | # now add nodes 78 | 79 | if (dr.nodes) { 80 | r <- c(n1$radius, n2$radius, n3$radius, n4$radius) 81 | phi <- c( 82 | rep(54.7, length(n1$radius)), 83 | rep(125.3, length(n2$radius)), 84 | rep(125.3, length(n3$radius)), 85 | rep(54.7, length(n4$radius)) 86 | ) 87 | theta <- c( 88 | rep(45, length(n1$radius)), 89 | rep(-45, length(n2$radius)), 90 | rep(135, length(n3$radius)), 91 | rep(-135, length(n4$radius)) 92 | ) 93 | n.df <- data.frame(radius = r, theta = theta, phi = phi) 94 | n.coord <- sph2cart(n.df) 95 | rgl::spheres3d(n.coord$x, n.coord$y, n.coord$z, 96 | col = c(n1$color, n2$color, n3$color, n4$color), 97 | radius = c(n1$size, n2$size, n3$size, n4$size) 98 | ) 99 | } 100 | 101 | # now draw edges 102 | 103 | tmp <- drawHiveSpline(HPD, LA = LA, ...) 104 | 105 | # add a center sphere 106 | 107 | rgl::spheres3d(0, 0, 0, col = "gray", radius = ch) 108 | 109 | # add axis labels if requested 110 | 111 | if (!is.null(axLabs)) { 112 | if (!length(axLabs) == nx) stop("Incorrect number of axis labels") 113 | r <- c(max1, max2, max3, max4) 114 | if (is.null(axLab.pos)) axLab.pos <- r * 0.1 115 | r <- r + axLab.pos 116 | phi <- c(54.7, 125.3, 125.3, 54.7) 117 | theta <- c(45, -45, 135, -135) 118 | t.df <- data.frame(radius = r, theta = theta, phi = phi) 119 | t.coord <- sph2cart(t.df) 120 | rgl::text3d(t.coord, texts = axLabs, adj = c(0.5, 0.5), col = "white") 121 | } 122 | } # end of 4D 123 | 124 | ##### Five dimensional case 125 | 126 | # Draw axes first 127 | 128 | if (nx == 5) { 129 | 130 | # n1 <- subset(nodes, axis == 1) 131 | # n2 <- subset(nodes, axis == 2) 132 | # n3 <- subset(nodes, axis == 3) 133 | # n4 <- subset(nodes, axis == 4) 134 | # n5 <- subset(nodes, axis == 5) 135 | 136 | n1 <- nodes[nodes[, "axis"] == 1, ] 137 | n2 <- nodes[nodes[, "axis"] == 2, ] 138 | n3 <- nodes[nodes[, "axis"] == 3, ] 139 | n4 <- nodes[nodes[, "axis"] == 4, ] 140 | n5 <- nodes[nodes[, "axis"] == 5, ] 141 | 142 | max1 <- max(n1$radius) 143 | max2 <- max(n2$radius) 144 | max3 <- max(n3$radius) 145 | max4 <- max(n4$radius) 146 | max5 <- max(n5$radius) 147 | min1 <- min(n1$radius) 148 | min2 <- min(n2$radius) 149 | min3 <- min(n3$radius) 150 | min4 <- min(n4$radius) 151 | min5 <- min(n5$radius) 152 | 153 | r <- c( 154 | min1, max1, min2, max2, min3, max3, 155 | min4, max4, min5, max5 156 | ) # in polar coordinates 157 | theta <- c(0, 0, 120, 120, 240, 240, 0, 0, 0, 0) # start, end, start, end 158 | phi <- c(90, 90, 90, 90, 90, 90, 0, 0, 180, 180) 159 | ax.df <- data.frame(radius = r, theta = theta, phi = phi) 160 | ax.coord <- sph2cart(ax.df) 161 | rgl::segments3d(ax.coord[1:2, ], col = axis.cols[1], line_antialias = TRUE, lwd = 4) 162 | rgl::segments3d(ax.coord[3:4, ], col = axis.cols[2], line_antialias = TRUE, lwd = 4) 163 | rgl::segments3d(ax.coord[5:6, ], col = axis.cols[3], line_antialias = TRUE, lwd = 4) 164 | rgl::segments3d(ax.coord[7:8, ], col = axis.cols[4], line_antialias = TRUE, lwd = 4) 165 | rgl::segments3d(ax.coord[9:10, ], col = axis.cols[5], line_antialias = TRUE, lwd = 4) 166 | 167 | # now add nodes 168 | 169 | if (dr.nodes) { 170 | r <- c(n1$radius, n2$radius, n3$radius, n4$radius, n5$radius) 171 | phi <- c( 172 | rep(90, length(n1$radius)), 173 | rep(90, length(n2$radius)), 174 | rep(90, length(n3$radius)), 175 | rep(0, length(n4$radius)), 176 | rep(180, length(n5$radius)) 177 | ) 178 | theta <- c( 179 | rep(0, length(n1$radius)), 180 | rep(120, length(n2$radius)), 181 | rep(240, length(n3$radius)), 182 | rep(0, length(n4$radius)), 183 | rep(0, length(n5$radius)) 184 | ) 185 | n.df <- data.frame(radius = r, theta = theta, phi = phi) 186 | n.coord <- sph2cart(n.df) 187 | rgl::spheres3d(n.coord$x, n.coord$y, n.coord$z, 188 | col = c(n1$color, n2$color, n3$color, n4$color, n5$color), 189 | radius = c(n1$size, n2$size, n3$size, n4$size, n5$size) 190 | ) 191 | } 192 | 193 | # now draw edges 194 | 195 | tmp <- drawHiveSpline(HPD, LA = LA, ...) 196 | 197 | # add a center sphere 198 | 199 | rgl::spheres3d(0, 0, 0, col = "gray", radius = ch) 200 | 201 | # add axis labels if requested 202 | 203 | if (!is.null(axLabs)) { 204 | if (!length(axLabs) == nx) stop("Incorrect number of axis labels") 205 | r <- c(max1, max2, max3, max4, max5) 206 | if (is.null(axLab.pos)) axLab.pos <- r * 0.1 207 | r <- r + axLab.pos 208 | phi <- c(90, 90, 90, 0, 180) 209 | theta <- c(0, 120, 240, 0, 0) 210 | t.df <- data.frame(radius = r, theta = theta, phi = phi) 211 | t.coord <- sph2cart(t.df) 212 | rgl::text3d(t.coord, texts = axLabs, adj = c(0.5, 0.5), col = "white") 213 | } 214 | } # end of 5D 215 | 216 | ##### Six dimensional case 217 | 218 | # Draw axes first 219 | 220 | if (nx == 6) { 221 | 222 | # n1 <- subset(nodes, axis == 1) 223 | # n2 <- subset(nodes, axis == 2) 224 | # n3 <- subset(nodes, axis == 3) 225 | # n4 <- subset(nodes, axis == 4) 226 | # n5 <- subset(nodes, axis == 5) 227 | # n6 <- subset(nodes, axis == 6) 228 | 229 | n1 <- nodes[nodes[, "axis"] == 1, ] 230 | n2 <- nodes[nodes[, "axis"] == 2, ] 231 | n3 <- nodes[nodes[, "axis"] == 3, ] 232 | n4 <- nodes[nodes[, "axis"] == 4, ] 233 | n5 <- nodes[nodes[, "axis"] == 5, ] 234 | n6 <- nodes[nodes[, "axis"] == 6, ] 235 | 236 | max1 <- max(n1$radius) 237 | max2 <- max(n2$radius) 238 | max3 <- max(n3$radius) 239 | max4 <- max(n4$radius) 240 | max5 <- max(n5$radius) 241 | max6 <- max(n6$radius) 242 | min1 <- min(n1$radius) 243 | min2 <- min(n2$radius) 244 | min3 <- min(n3$radius) 245 | min4 <- min(n4$radius) 246 | min5 <- min(n5$radius) 247 | min6 <- min(n6$radius) 248 | 249 | r <- c( 250 | min1, max1, min2, max2, min3, max3, 251 | min4, max4, min5, max5, min6, max6 252 | ) # in polar coordinates 253 | theta <- c(0, 0, 90, 90, 180, 180, 270, 270, 0, 0, 0, 0) # start, end, start, end 254 | phi <- c(90, 90, 90, 90, 90, 90, 90, 90, 0, 0, 180, 180) 255 | ax.df <- data.frame(radius = r, theta = theta, phi = phi) 256 | ax.coord <- sph2cart(ax.df) 257 | rgl::segments3d(ax.coord[1:2, ], col = axis.cols[1], line_antialias = TRUE, lwd = 4) 258 | rgl::segments3d(ax.coord[3:4, ], col = axis.cols[2], line_antialias = TRUE, lwd = 4) 259 | rgl::segments3d(ax.coord[5:6, ], col = axis.cols[3], line_antialias = TRUE, lwd = 4) 260 | rgl::segments3d(ax.coord[7:8, ], col = axis.cols[4], line_antialias = TRUE, lwd = 4) 261 | rgl::segments3d(ax.coord[9:10, ], col = axis.cols[5], line_antialias = TRUE, lwd = 4) 262 | rgl::segments3d(ax.coord[11:12, ], col = axis.cols[6], line_antialias = TRUE, lwd = 4) 263 | 264 | # now add nodes 265 | 266 | if (dr.nodes) { 267 | r <- c(n1$radius, n2$radius, n3$radius, n4$radius, n5$radius, n6$radius) 268 | phi <- c( 269 | rep(90, length(n1$radius)), 270 | rep(90, length(n2$radius)), 271 | rep(90, length(n3$radius)), 272 | rep(90, length(n4$radius)), 273 | rep(0, length(n5$radius)), 274 | rep(180, length(n6$radius)) 275 | ) 276 | theta <- c( 277 | rep(0, length(n1$radius)), 278 | rep(90, length(n2$radius)), 279 | rep(180, length(n3$radius)), 280 | rep(270, length(n4$radius)), 281 | rep(0, length(n5$radius)), 282 | rep(0, length(n6$radius)) 283 | ) 284 | n.df <- data.frame(radius = r, theta = theta, phi = phi) 285 | n.coord <- sph2cart(n.df) 286 | rgl::spheres3d(n.coord$x, n.coord$y, n.coord$z, 287 | col = c(n1$color, n2$color, n3$color, n4$color, n5$color, n6$color), 288 | radius = c(n1$size, n2$size, n3$size, n4$size, n5$size, n6$size) 289 | ) 290 | } 291 | 292 | # now draw edges 293 | 294 | tmp <- drawHiveSpline(HPD, LA = LA, ...) 295 | 296 | # add a center sphere 297 | 298 | rgl::spheres3d(0, 0, 0, col = "gray", radius = ch) 299 | 300 | # add axis labels if requested 301 | 302 | if (!is.null(axLabs)) { 303 | if (!length(axLabs) == nx) stop("Incorrect number of axis labels") 304 | r <- c(max1, max2, max3, max4, max5, max6) 305 | if (is.null(axLab.pos)) axLab.pos <- r * 0.1 306 | r <- r + axLab.pos 307 | phi <- c(90, 90, 90, 90, 0, 180) 308 | theta <- c(0, 90, 180, 270, 0, 0) 309 | t.df <- data.frame(radius = r, theta = theta, phi = phi) 310 | t.coord <- sph2cart(t.df) 311 | rgl::text3d(t.coord, texts = axLabs, adj = c(0.5, 0.5), col = "white") 312 | } 313 | } # end of 6D 314 | } # closing brace, this is the end! 315 | -------------------------------------------------------------------------------- /R/ranHiveData.R: -------------------------------------------------------------------------------- 1 | #' Generate Random Hive Plot Data 2 | #' 3 | #' This function generates random data sets which can be used to make a hive 4 | #' plot. 5 | #' 6 | #' For \code{type = "2D"}, after the function creates an initial set of random 7 | #' nodes, these are randomly chosen and connected between adjacent axes, so 8 | #' that no edge crosses an axis. \cr \cr For \code{type = "3D"}, after the 9 | #' function creates an initial set of random nodes and edges, these are cleaned 10 | #' up by removing the following cases (which the rest of \code{HiveR} is not 11 | #' intended to handle at this time): duplicated nodes, nodes that are not part 12 | #' of any edge, edges that begin and end on the same point, edges that begin 13 | #' and end on the same axis, and finally, for \code{nx = 5 or 6}, edges that 14 | #' begin and end on colinear axes. Most of these don't cause an error, but 15 | #' produce some ugly results. \cr \cr For the arguments \code{rad, ns, ew, nc} 16 | #' and \code{ec}, the values given are sampled randomly (with replacement) and 17 | #' assigned to particular nodes or edges. 18 | #' 19 | #' @param type The type of hive plot to be generated. One of \code{c("2D", 20 | #' "3D")}. 21 | #' 22 | #' @param nx An integer giving the number of axes to be created (\code{2 =< nx 23 | #' =< 6}). 24 | #' 25 | #' @param nn An integer giving the number of nodes to be created. This is an 26 | #' initial number which may be reduced during clean up. See Details. 27 | #' 28 | #' @param ne An integer giving the number of edges to be created. This is an 29 | #' initial number which may be reduced during clean up. See Details. 30 | #' 31 | #' @param rad Numeric; a range of values that will be used as node radius 32 | #' values (the position of the node along the axis). 33 | #' 34 | #' @param ns Numeric; a range of values that will be used as the node sizes. 35 | #' 36 | #' @param ew Numeric; a range of values that will be used as the edge weights. 37 | #' 38 | #' @param nc A vector of valid color names giving the node colors. 39 | #' 40 | #' @param ec A vector of valid color names giving the edge colors. 41 | #' 42 | #' @param axis.cols A vector of valid color names to be used to color the axes; 43 | #' \code{length(axis.cols) must = nx}. 44 | #' 45 | #' @param desc Character; a description of the data set. 46 | #' 47 | #' @param allow.same Logical; indicates if edges may begin and end on the same 48 | #' axis. Only applies to \code{type = 2D}. 49 | #' 50 | #' @param verbose Logical; If \code{TRUE}, the generation, processing and final 51 | #' result is reported to the console. 52 | #' 53 | #' @return An object of S3 class \code{\link{HivePlotData}}. 54 | #' 55 | #' @section Warning: If you create a very small data set with few nodes, there 56 | #' may be no nodes assigned to some axes which will give an error when you try 57 | #' to plot the data. It's up to the user to check for this possibility (you 58 | #' can use \code{sumHPD}). 59 | #' 60 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 61 | #' 62 | #' @keywords datagen 63 | #' 64 | #' @examples 65 | #' 66 | #' test4 <- ranHiveData(nx = 4) 67 | #' str(test4) 68 | #' sumHPD(test4) 69 | #' @export ranHiveData 70 | #' 71 | ranHiveData <- function(type = "2D", nx = 4, 72 | nn = nx * 15, ne = nx * 15, 73 | rad = 1:100, ns = c(0.5, 1.0, 1.5), ew = 1:3, 74 | nc = brewer.pal(5, "Set1"), 75 | ec = brewer.pal(5, "Set1"), 76 | axis.cols = brewer.pal(nx, "Set1"), 77 | desc = NULL, allow.same = FALSE, 78 | verbose = FALSE) { 79 | 80 | # Function to generate random data for testing/demonstrating HiveR 81 | # Bryan Hanson, DePauw Univ, June 2011 onward 82 | 83 | # Defaults make small hives that draw fast and are not too cluttered 84 | 85 | # type = whether data is to be plotted 2D or 3D 86 | # nx = no. axes 87 | # nn = no. nodes 88 | # ne = no. edges 89 | # nc = node color 90 | # ec = edge color 91 | # rad = possible values for radii 92 | # ns = node size 93 | # ew = edge weight/width 94 | # desc = description 95 | 96 | if (!requireNamespace("RColorBrewer", quietly = TRUE)) { 97 | stop("You need to install package RColorBrewer to use this function") 98 | } 99 | 100 | if ((nx == 1) | (nx > 6)) stop("nx out of bounds: 2 =< nx =< 6") 101 | 102 | 103 | # Create a set of labels/names to choose from 104 | 105 | Labs <- rep(NA, nn) 106 | for (n in 1:nn) { 107 | Labs[n] <- rep(paste(letters[stats::runif(1, 1, 26)], 108 | letters[stats::runif(1, 1, 26)], 109 | letters[stats::runif(1, 1, 26)], 110 | letters[stats::runif(1, 1, 26)], 111 | letters[stats::runif(1, 1, 26)], 112 | sep = "" 113 | )) 114 | } 115 | 116 | # Create nodes df 117 | 118 | ndf <- data.frame( 119 | id = 1:nn, 120 | lab = as.character(Labs), 121 | axis = sample(1:nx, nn, replace = TRUE), 122 | radius = sample(rad, nn, replace = TRUE), 123 | size = sample(ns, nn, replace = TRUE), 124 | color = sample(nc, nn, replace = TRUE) 125 | ) 126 | ndf$color <- as.character(ndf$color) 127 | 128 | # Clean up ndf by removing duplicates 129 | # (do before the creation of edf calls on these points) 130 | # Important: this means that nodes$id is not continuous! 131 | 132 | dup <- duplicated(ndf[, c(3, 4)]) 133 | if (any(dup)) { 134 | ndf <- ndf[-dup, ] 135 | if (verbose) cat(length(any(!dup)), "duplicate nodes were removed\n\n") 136 | } 137 | 138 | ##### Time to create the nodes. 139 | ##### Note that nx = 2 or 3 are going to be the same regardless of type 140 | ##### and they will be plotted with plotHive not plot3dHive. 141 | ##### As a result, there are 3 if statements below. 142 | 143 | if ((nx == 2) | (nx == 3)) { ###### 2D edges for nx = 2 or 3 144 | 145 | # Create edges df 146 | 147 | edf <- data.frame( 148 | id1 = sample(ndf$id, ne, replace = TRUE), 149 | id2 = sample(ndf$id, ne, replace = TRUE), 150 | weight = sample(ew, ne, replace = TRUE), 151 | color = as.character(sample(ec, ne, replace = TRUE)) 152 | ) 153 | edf$color <- as.character(edf$color) 154 | 155 | # Clean up edf 156 | 157 | # remove edges that start & end on the same point 158 | 159 | same.pt <- which(edf$id1 == edf$id2) 160 | if (length(!same.pt == 0)) { 161 | edf <- edf[-same.pt, ] 162 | if (verbose) cat("Removing an edge (same.pt) = ", same.pt, "\n\n") 163 | } 164 | 165 | # remove edges that start & end on the same axis 166 | 167 | if (!allow.same) { 168 | same.axis <- c() 169 | 170 | if (nx >= 2) { 171 | one <- which(ndf$axis == 1) # row indices 172 | one <- ndf$id[one] # id values 173 | two <- which(ndf$axis == 2) # row indices 174 | two <- ndf$id[two] # id values 175 | for (n in 1:nrow(edf)) { 176 | if ((edf$id1[n] %in% one) && (edf$id2[n] %in% one)) same.axis <- c(same.axis, n) 177 | if ((edf$id1[n] %in% two) && (edf$id2[n] %in% two)) same.axis <- c(same.axis, n) 178 | } 179 | } 180 | 181 | if (nx == 3) { 182 | three <- which(ndf$axis == 3) # row indices 183 | three <- ndf$id[three] # id values 184 | for (n in 1:nrow(edf)) if ((edf$id1[n] %in% three) && (edf$id2[n] %in% three)) same.axis <- c(same.axis, n) 185 | } 186 | 187 | if (length(!same.axis == 0)) { 188 | edf <- edf[-same.axis, ] 189 | if (verbose) cat("Removing an edge (same.axis) = ", same.axis, "\n\n") 190 | } 191 | } 192 | } ###### End of 2D edges for nx = 2 or 3 193 | 194 | if ((type == "3D") & (nx > 3)) { ###### 3D edge generation and checking for nx > 3 195 | 196 | # Create edges df 197 | 198 | edf <- data.frame( 199 | id1 = sample(ndf$id, ne, replace = TRUE), 200 | id2 = sample(ndf$id, ne, replace = TRUE), 201 | weight = sample(ew, ne, replace = TRUE), 202 | color = as.character(sample(ec, ne, replace = TRUE)) 203 | ) 204 | edf$color <- as.character(edf$color) 205 | 206 | # Clean up edf 207 | 208 | # remove edges that start & end on the same point 209 | same.pt <- which(edf$id1 == edf$id2) 210 | if (length(!same.pt == 0)) { 211 | edf <- edf[-same.pt, ] 212 | if (verbose) cat("Removing an edge (same.pt) = ", same.pt, "\n\n") 213 | } 214 | 215 | # remove edges that start & end on the same axis 216 | 217 | same.axis <- c() 218 | 219 | if (nx >= 2) { # going to use these values later too when checking colinearity 220 | one <- which(ndf$axis == 1) # row indices 221 | one <- ndf$id[one] # id values 222 | two <- which(ndf$axis == 2) # row indices 223 | two <- ndf$id[two] # id values 224 | for (n in 1:nrow(edf)) { 225 | if ((edf$id1[n] %in% one) && (edf$id2[n] %in% one)) same.axis <- c(same.axis, n) 226 | if ((edf$id1[n] %in% two) && (edf$id2[n] %in% two)) same.axis <- c(same.axis, n) 227 | } 228 | } 229 | 230 | if (nx >= 3) { 231 | three <- which(ndf$axis == 3) # row indices 232 | three <- ndf$id[three] # id values 233 | for (n in 1:nrow(edf)) if ((edf$id1[n] %in% three) && (edf$id2[n] %in% three)) same.axis <- c(same.axis, n) 234 | } 235 | 236 | if (nx >= 4) { 237 | four <- which(ndf$axis == 4) # row indices 238 | four <- ndf$id[four] # id values 239 | for (n in 1:nrow(edf)) if ((edf$id1[n] %in% four) && (edf$id2[n] %in% four)) same.axis <- c(same.axis, n) 240 | } 241 | 242 | if (nx >= 5) { 243 | five <- which(ndf$axis == 5) 244 | five <- ndf$id[five] 245 | for (n in 1:nrow(edf)) if ((edf$id1[n] %in% five) && (edf$id2[n] %in% five)) same.axis <- c(same.axis, n) 246 | } 247 | 248 | if (nx == 6) { 249 | six <- which(ndf$axis == 6) # row indices 250 | six <- ndf$id[six] # id values 251 | for (n in 1:nrow(edf)) if ((edf$id1[n] %in% six) && (edf$id2[n] %in% six)) same.axis <- c(same.axis, n) 252 | } 253 | 254 | if (length(!same.axis == 0)) { 255 | edf <- edf[-same.axis, ] 256 | if (verbose) cat("Removing an edge (same.axis) = ", same.axis, "\n\n") 257 | } 258 | 259 | # For nx = 5 and 6, we need to remove edges that start and end on colinear axes 260 | 261 | colin <- c() 262 | 263 | if (nx == 5) { # axes 4 & 5 are colinear 264 | 265 | for (n in 1:nrow(edf)) { 266 | if ((edf$id1[n] %in% four) && (edf$id2[n] %in% five)) colin <- c(colin, n) 267 | if ((edf$id1[n] %in% five) && (edf$id2[n] %in% four)) colin <- c(colin, n) 268 | } 269 | 270 | if (length(!colin == 0)) { 271 | edf <- edf[-colin, ] # remove the colinear edges 272 | if (verbose) cat("Removing colinear edges (nx = 5): ", colin, "\n\n") 273 | } 274 | } 275 | 276 | if (nx == 6) { 277 | 278 | # axes 1 & 3, 2 & 4, 5 & 6 are colinear 279 | 280 | for (n in 1:nrow(edf)) { 281 | if ((edf$id1[n] %in% one) && (edf$id2[n] %in% three)) colin <- c(colin, n) 282 | if ((edf$id1[n] %in% two) && (edf$id2[n] %in% four)) colin <- c(colin, n) 283 | if ((edf$id1[n] %in% five) && (edf$id2[n] %in% six)) colin <- c(colin, n) 284 | } 285 | 286 | if (length(!colin == 0)) { 287 | edf <- edf[-colin, ] # remove the colinear edges 288 | if (verbose) cat("Removing colinear edges (nx = 5): ", colin, "\n\n") 289 | } 290 | } 291 | } ##### end of 3D edge generation and checking 292 | 293 | if ((type == "2D") & (nx > 3)) { ###### 2D edge generation and checking 294 | 295 | # Create edges df 296 | # In this case, edges must be 1->2, 2->3... 5->6 but not 3->5 297 | # i.e. no crossings. Thus they are pretty much done manually 298 | 299 | # Select from possibilites pairwise, roughly equal no. per axis pair 300 | 301 | ne <- round(ne / nx) # divide edges among axes 302 | if (allow.same) ne <- ne / nx # acct for edges st/end on same axis 303 | 304 | one <- which(ndf$axis == 1) # row indices 305 | one <- ndf$id[one] # id values 306 | two <- which(ndf$axis == 2) # row indices 307 | two <- ndf$id[two] # id values 308 | three <- which(ndf$axis == 3) # row indices 309 | three <- ndf$id[three] # id values 310 | 311 | if (nx >= 4) { 312 | four <- which(ndf$axis == 4) # row indices 313 | four <- ndf$id[four] # id values 314 | } 315 | 316 | if (nx >= 5) { 317 | five <- which(ndf$axis == 5) 318 | five <- ndf$id[five] 319 | } 320 | 321 | if (nx == 6) { 322 | six <- which(ndf$axis == 6) # row indices 323 | six <- ndf$id[six] # id values 324 | } 325 | 326 | id1 <- id2 <- c() 327 | 328 | if (nx == 4) { 329 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 330 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 331 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 332 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 333 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 334 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 335 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 336 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 337 | 338 | if (allow.same) { 339 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 340 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 341 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 342 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 343 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 344 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 345 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 346 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 347 | } 348 | } 349 | 350 | if (nx == 5) { 351 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 352 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 353 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 354 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 355 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 356 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 357 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 358 | id2 <- c(id2, sample(five, ne, replace = TRUE)) 359 | id1 <- c(id1, sample(five, ne, replace = TRUE)) 360 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 361 | 362 | if (allow.same) { 363 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 364 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 365 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 366 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 367 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 368 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 369 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 370 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 371 | id1 <- c(id1, sample(five, ne, replace = TRUE)) 372 | id2 <- c(id2, sample(five, ne, replace = TRUE)) 373 | } 374 | } 375 | 376 | if (nx == 6) { 377 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 378 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 379 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 380 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 381 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 382 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 383 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 384 | id2 <- c(id2, sample(five, ne, replace = TRUE)) 385 | id1 <- c(id1, sample(five, ne, replace = TRUE)) 386 | id2 <- c(id2, sample(six, ne, replace = TRUE)) 387 | id1 <- c(id1, sample(six, ne, replace = TRUE)) 388 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 389 | 390 | if (allow.same) { 391 | id1 <- c(id1, sample(one, ne, replace = TRUE)) 392 | id2 <- c(id2, sample(one, ne, replace = TRUE)) 393 | id1 <- c(id1, sample(two, ne, replace = TRUE)) 394 | id2 <- c(id2, sample(two, ne, replace = TRUE)) 395 | id1 <- c(id1, sample(three, ne, replace = TRUE)) 396 | id2 <- c(id2, sample(three, ne, replace = TRUE)) 397 | id1 <- c(id1, sample(four, ne, replace = TRUE)) 398 | id2 <- c(id2, sample(four, ne, replace = TRUE)) 399 | id1 <- c(id1, sample(five, ne, replace = TRUE)) 400 | id2 <- c(id2, sample(five, ne, replace = TRUE)) 401 | id1 <- c(id1, sample(six, ne, replace = TRUE)) 402 | id2 <- c(id2, sample(six, ne, replace = TRUE)) 403 | } 404 | } 405 | 406 | edf <- data.frame( # clean momentaril 407 | id1 = id1, 408 | id2 = id2, 409 | weight = sample(ew, ne, replace = TRUE), 410 | color = as.character(sample(ec, ne, replace = TRUE)) 411 | ) 412 | edf$color <- as.character(edf$color) 413 | 414 | # Remove edges that start & end on the same point 415 | # (allow.same may have introduced some new cases) 416 | 417 | same.pt <- which(edf$id1 == edf$id2) 418 | if (length(!same.pt == 0)) { 419 | edf <- edf[-same.pt, ] 420 | if (verbose) cat("Removing an edge (same.pt) = ", same.pt, "\n\n") 421 | } 422 | } ##### end of 2D edge generation and checking 423 | 424 | # The rest of this applies to 2D and 3D 425 | 426 | # Finally, remove nodes that are not part of an edge 427 | # Note: another reason that nodes$id is not continous 428 | 429 | draw <- ndf$id %in% unique(c(edf$id1, edf$id2)) 430 | if (any(!draw)) { 431 | ndf1 <- nrow(ndf) 432 | ndf <- ndf[draw, ] 433 | ndf2 <- nrow(ndf) 434 | if (verbose) cat(ndf1 - ndf2, "nodes did not have any edges and have been removed\n\n") 435 | } 436 | 437 | # Report results (also creates desc if needed): 438 | 439 | msg1 <- paste(nx, " axes -- ", dim(ndf)[1], " nodes -- ", dim(edf)[1], " edges", sep = "") 440 | msg2 <- paste("Data set is", msg1) 441 | if (verbose) cat(msg2, "\n") 442 | 443 | if (!is.null(desc)) desc <- paste(desc, " (", msg1, ")", sep = "") 444 | if (is.null(desc)) desc <- msg1 445 | 446 | # Fix up classes to meet definition 447 | 448 | ndf$lab <- as.character(ndf$lab) 449 | ndf$radius <- as.numeric(ndf$radius) 450 | edf$weight <- as.numeric(edf$weight) 451 | type <- type 452 | res <- list( 453 | nodes = ndf, 454 | edges = edf, 455 | type = type, 456 | desc = desc, 457 | axis.cols = axis.cols 458 | ) 459 | class(res) <- "HivePlotData" 460 | chkHPD(res) 461 | 462 | res 463 | } 464 | -------------------------------------------------------------------------------- /R/rcsr.R: -------------------------------------------------------------------------------- 1 | #' Compute the Details of a 3D Spline for a Hive Plot Edge 2 | #' 3 | #' This is a wild bit of trigonometry! Three points in 3D space, two ends and 4 | #' an control point, are rotated into 2D space. Then a spline curve is 5 | #' computed. This is necessary because spline curves are only defined in 6 | #' \code{R} as 2D objects. The new collection of points, which is the complete 7 | #' spline curve and when drawn will be the edge of a hive plot, is rotated back 8 | #' into the original 3D space. \code{rcsr} stands for rotate, compute spline, 9 | #' rotate back. 10 | #' 11 | #' See the code for exactly how the function works. Based upon the process 12 | #' described at \url{http://www.fundza.com/mel/axis_to_vector/index.html} 13 | #' Timing tests show this function is fast and scales linearly (i.e. 10x more 14 | #' splines to draw takes 10x more time). Roughly 3 seconds were required to 15 | #' draw 1,000 spline curves in my testing. 16 | #' 17 | #' @param p0 A triple representing one end of the final curve (x, y, z). 18 | #' 19 | #' @param cp A triple representing the control point used to compute the final 20 | #' curve (x, y, z). 21 | #' 22 | #' @param p1 A triple representing the other end of the final curve (x, y, z). 23 | #' 24 | #' @return A 3 column matrix with the x, y and z coordinates to be plotted to 25 | #' create a hive plot edge. 26 | #' 27 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 28 | #' 29 | #' @keywords utilities 3D spline 30 | #' 31 | #' @export rcsr 32 | #' 33 | #' @importFrom stats spline 34 | #' 35 | #' @examples 36 | #' 37 | #' # This is a lengthy example to prove it works. 38 | #' # Read it and then copy the whole thing to a blank script. 39 | #' # Parts of it require rgl and are interactive. 40 | #' # So none of the below is run during package build/check. 41 | #' 42 | #' ### First, a helper function 43 | #' \dontrun{ 44 | #' 45 | #' drawUnitCoord <- function() { 46 | #' 47 | #' # Simple function to draw a unit 3D coordinate system 48 | #' 49 | #' # Draw a Coordinate System 50 | #' 51 | #' r <- c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) # in polar coordinates 52 | #' theta <- c(0, 0, 0, 90, 0, 180, 0, 270, 0, 0, 0, 0) # start, end, start, end 53 | #' phi <- c(0, 90, 0, 90, 0, 90, 0, 90, 0, 0, 0, 180) 54 | #' cs <- data.frame(radius = r, theta, phi) 55 | #' ax.coord <- sph2cart(cs) 56 | #' 57 | #' segments3d(ax.coord, col = "gray", line_antialias = TRUE) 58 | #' points3d( 59 | #' x = 0, y = 0, z = 0, color = "black", size = 4, 60 | #' point_antialias = TRUE 61 | #' ) # plot origin 62 | #' 63 | #' # Label the axes 64 | #' 65 | #' r <- c(1.1, 1.1, 1.1, 1.1, 1.1, 1.1) # in polar coordinates 66 | #' theta <- c(0, 90, 180, 270, 0, 0) 67 | #' phi <- c(90, 90, 90, 90, 0, 180) 68 | #' l <- data.frame(radius = r, theta, phi) 69 | #' lab.coord <- sph2cart(l) 70 | #' text3d(lab.coord, texts = c("+x", "+y", "-x", "-y", "+z", "-z")) 71 | #' } 72 | #' 73 | #' ### Now, draw a reference coordinate system and demo the function in it. 74 | #' 75 | #' drawUnitCoord() 76 | #' 77 | #' ### Draw a bounding box 78 | #' 79 | #' box <- data.frame( 80 | #' x = c(1, -1, 1, 1, 1, 1, 1, 1, 1, -1, -1, -1, 1, 1, 1, -1, 1, -1, -1, -1, -1, -1, -1, -1), 81 | #' y = c(1, 1, 1, 1, 1, -1, 1, -1, 1, 1, 1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, 1), 82 | #' z = c(1, 1, 1, -1, 1, 1, -1, -1, -1, -1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, 1, 1, -1, -1) 83 | #' ) 84 | #' 85 | #' segments3d(box$x, box$y, box$z, line_antialias = TRUE, col = "red") 86 | #' 87 | #' ### Draw the midlines defining planes 88 | #' 89 | #' mid <- data.frame( 90 | #' x = c(0, 0, 0, 0, 0, 0, 0, 0, 1, -1, -1, -1, -1, 1, 1, 1, 1, -1, -1, -1, -1, 1, 1, 1), 91 | #' y = c(-1, -1, -1, 1, 1, 1, 1, -1, 0, 0, 0, 0, 0, 0, 0, 0, -1, -1, -1, 1, 1, 1, 1, -1), 92 | #' z = c(-1, 1, 1, 1, 1, -1, -1, -1, -1, -1, -1, 1, 1, 1, 1, -1, 0, 0, 0, 0, 0, 0, 0, 0) 93 | #' ) 94 | #' 95 | #' segments3d(mid$x, mid$y, mid$z, line_antialias = TRUE, col = "blue") 96 | #' 97 | #' ### Generate two random points 98 | #' 99 | #' p <- runif(6, -1, 1) 100 | #' 101 | #' # Special case where p1 is on z axis 102 | #' # Uncomment line below to demo 103 | #' # p[4:5] <- 0 104 | #' 105 | #' p0 <- c(p[1], p[2], p[3]) 106 | #' p1 <- c(p[4], p[5], p[6]) 107 | #' 108 | #' ### Draw the pts, label them, draw vectors to those pts from origin 109 | #' 110 | #' segments3d( 111 | #' x = c(0, p[1], 0, p[4]), 112 | #' y = c(0, p[2], 0, p[5]), 113 | #' z = c(0, p[3], 0, p[6]), 114 | #' line_antialias = TRUE, col = "black", lwd = 3 115 | #' ) 116 | #' 117 | #' points3d( 118 | #' x = c(p[1], p[4]), 119 | #' y = c(p[2], p[5]), 120 | #' z = c(p[3], p[6]), 121 | #' point_antialias = TRUE, col = "black", size = 8 122 | #' ) 123 | #' 124 | #' text3d( 125 | #' x = c(p[1], p[4]), 126 | #' y = c(p[2], p[5]), 127 | #' z = c(p[3], p[6]), 128 | #' col = "black", texts = c("p0", "p1"), adj = c(1, 1) 129 | #' ) 130 | #' 131 | #' ### Locate control point 132 | #' ### Compute and draw net vector from origin thru cp 133 | #' ### Connect p0 and p1 134 | #' 135 | #' s <- p0 + p1 136 | #' segments3d( 137 | #' x = c(0, s[1]), y = c(0, s[2]), z = c(0, s[3]), 138 | #' line_antialias = TRUE, col = "grey", lwd = 3 139 | #' ) 140 | #' 141 | #' segments3d( 142 | #' x = c(p[1], p[4]), # connect p0 & p1 143 | #' y = c(p[2], p[5]), 144 | #' z = c(p[3], p[6]), 145 | #' line_antialias = TRUE, col = "grey", lwd = 3 146 | #' ) 147 | #' 148 | #' cp <- 0.6 * s # Now for the control point 149 | #' 150 | #' points3d( 151 | #' x = cp[1], # Plot the control point 152 | #' y = cp[2], 153 | #' z = cp[3], 154 | #' point_antialias = TRUE, col = "black", size = 8 155 | #' ) 156 | #' 157 | #' text3d( 158 | #' x = cp[1], # Label the control point 159 | #' y = cp[2], 160 | #' z = cp[3], 161 | #' texts = c("cp"), col = "black", adj = c(1, 1) 162 | #' ) 163 | #' 164 | #' ### Now ready to work on the spline curve 165 | #' 166 | #' n2 <- rcsr(p0, cp, p1) # Compute the spline 167 | #' 168 | #' lines3d( 169 | #' x = n2[, 1], y = n2[, 2], z = n2[, 3], 170 | #' line_antialias = TRUE, col = "blue", lwd = 3 171 | #' ) 172 | #' 173 | #' ### Ta-Da!!!!! 174 | #' } 175 | #' 176 | rcsr <- function(p0, cp, p1) { 177 | 178 | # Bryan Hanson, DePauw Univ, April 2011 179 | 180 | # Function to take 3 points in 3d and compute a spline curve 181 | # using them. The strategy is to rotate into a 2d system, 182 | # figure the spline, and then rotate back to the orig 3d system. 183 | 184 | # p0 and p1 are end points, cp is the control point 185 | 186 | # rcsr = rotate, compute spline, rotate back 187 | 188 | # Local copies of functions borrowed from RFOC 189 | 190 | rotx3 <- function(deg) { 191 | rad1 <- deg * 0.0174532925199 192 | r <- diag(3) 193 | r[2, 2] <- cos(rad1) 194 | r[2, 3] <- sin(rad1) 195 | r[3, 3] <- r[2, 2] 196 | r[3, 2] <- -r[2, 3] 197 | return(r) 198 | } 199 | 200 | roty3 <- function(deg) { 201 | rad1 <- deg * 0.0174532925199 202 | r <- diag(3) 203 | r[1, 1] <- cos(rad1) 204 | r[3, 1] <- sin(rad1) 205 | r[3, 3] <- r[1, 1] 206 | r[1, 3] <- -r[3, 1] 207 | return(r) 208 | } 209 | 210 | rotz3 <- function(deg) { 211 | rad1 <- deg * 0.0174532925199 212 | r <- diag(3) 213 | r[1, 1] <- cos(rad1) 214 | r[1, 2] <- sin(rad1) 215 | r[2, 2] <- r[1, 1] 216 | r[2, 1] <- -r[1, 2] 217 | return(r) 218 | } 219 | 220 | m <- matrix(c(0, 0, 0, p0, cp, p1), nrow = 4, byrow = TRUE) 221 | 222 | # Align p0 with the +y axis by rotating around x and z axes 223 | # see www.fundza.com/mel/axis_to_vector/align_axis_to_vector.html 224 | # Other points follow using rotation matrix 225 | 226 | xyL <- sqrt(m[2, 1]^2 + m[2, 2]^2) 227 | vL <- sqrt(sum((m[2, ]^2))) 228 | 229 | if (xyL == 0) { # have to catch when p1 is on z axis 230 | zA <- ifelse(m[2, 1] > 0, 90, -90) 231 | } else { 232 | zA <- acos(m[2, 2] / xyL) 233 | zA <- ifelse(m[2, 1] > 0, -zA, zA) # adjusts for quadrant 234 | } 235 | zA <- zA * 180 / pi 236 | zA <- rotz3(zA) 237 | 238 | xA <- acos(xyL / vL) 239 | xA <- ifelse(m[2, 3] > 0, xA, -xA) # adjusts for quadrant 240 | xA <- xA * 180 / pi 241 | xA <- rotx3(xA) 242 | 243 | n1 <- t(zA %*% t(m)) # order of rotations matter! 244 | n2 <- t(xA %*% t(n1)) 245 | 246 | # Now rotate p1 to +x+y plane by rotating around y axis 247 | 248 | yzL <- sqrt(n2[4, 1]^2 + n2[4, 3]^2) 249 | 250 | yA <- acos(n2[4, 3] / yzL) 251 | yA <- ifelse(n2[4, 1] > 0, yA, -yA) # adjusts for quadrant 252 | yA <- 90 + (yA * 180 / pi) 253 | yA <- roty3(yA) 254 | 255 | n3 <- t(yA %*% t(n2)) 256 | 257 | # Compute spline curve 258 | n3 <- n3[-1, ] # remove origin point 259 | sp <- stats::spline(n3[, 1], n3[, 2], n = 25) 260 | sp <- matrix(c(sp$x, sp$y, rep(0, length(sp$x))), ncol = 3) # add back the z coord (all 0's) 261 | 262 | # Now reverse the transformations back to the original 3d space 263 | 264 | sp <- t(t(yA) %*% t(sp)) 265 | sp <- t(t(xA) %*% t(sp)) 266 | sp <- t(t(zA) %*% t(sp)) 267 | sp 268 | } 269 | -------------------------------------------------------------------------------- /R/sph2cart.R: -------------------------------------------------------------------------------- 1 | #' Convert Spherical to Cartesian Coordinates 2 | #' 3 | #' This function converts spherical to Cartesian coordinates. 4 | #' 5 | #' 6 | #' @param df A data frame with columns named r, theta and phi with the radius 7 | #' and angles (in spherical coordinates) to be converted to Cartesian 8 | #' coordinates. 9 | #' 10 | #' @return A data frame with named columns containing the converted 11 | #' coordinates. 12 | #' 13 | #' @note Cobbled together from similar functions in other packages. 14 | #' 15 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 16 | #' 17 | #' @keywords utilities 18 | #' 19 | #' @export sph2cart 20 | #' 21 | sph2cart <- function(df) { 22 | 23 | # Bryan Hanson 24 | # DePauw Univ, Feb 2011 25 | 26 | theta <- df$theta * 2 * pi / 360 # input angles in degrees 27 | phi <- df$phi * 2 * pi / 360 28 | x <- df$r * cos(theta) * sin(phi) 29 | y <- df$r * sin(theta) * sin(phi) 30 | z <- df$r * cos(phi) 31 | ans <- data.frame(x, y, z) 32 | } # answer in degrees 33 | -------------------------------------------------------------------------------- /R/sumHPD.R: -------------------------------------------------------------------------------- 1 | #' Summarize a Hive Plot Data Object and Optionally Run Some Checks 2 | #' 3 | #' This function summarizes a \code{\link{HivePlotData}} object in a convenient 4 | #' form. Optionally, it can run some checks for certain conditions that may be 5 | #' of interest. It can also output a summary of edges to be drawn, either as a 6 | #' data frame or in a LaTeX ready form, or a data frame of orphaned nodes. 7 | #' 8 | #' Argument \code{chk.sm.pt} applies only to hive plots of \code{type = 2D}. 9 | #' It checks to see if any of the edges start and end at the same node id. 10 | #' These by definition exist at the same radius on the same axis, which 11 | #' causes an error in \code{plotHive} since you are trying to draw an edge of 12 | #' length zero (the actual error message is \code{Error in calcCurveGrob(x, 13 | #' x$debug) : End points must not be identical}. Some data sets may have such 14 | #' cases intrinsically or due to data entry error, or the condition may arise 15 | #' during processing. Either way, one needs to be able to detect such cases 16 | #' for removal or modification. This argument will tell you which nodes cause 17 | #' the problem. 18 | #' 19 | #' Argument \code{chk.virtual.edge} applies only to hive plots of \code{type = 2D} 20 | #' and is similiar to \code{chk.sm.pt} above except 21 | #' that it checks for virtual edges. These are edges start and end on the 22 | #' same axis at the same radius but at different node id's (in other words, 23 | #' two nodes have the same radius on the same axis). This condition 24 | #' gives the same error as above. It is checked for separately as it arises 25 | #' via a different problem in the construction of the data. 26 | #' 27 | #' Argument \code{chk.ax.jump} applies only to hive plots 28 | #' of \code{type = 2D}. It checks to see if any of the edges jump an axis, 29 | #' e.g. axis 1 --> axis 3. This argument will tell you which nodes are at 30 | #' either end of the jumping edge. Jumping should should be avoided in hive 31 | #' plots as it makes the plot aesthetically unpleasing. However, depending 32 | #' upon how you process the data, this condition may arise and hence it is 33 | #' useful to be able to locate jumps. 34 | #' 35 | #' @param HPD An object of S3 class \code{HivePlotData}. 36 | #' 37 | #' @param chk.all Logical; should all the checks below be run? See Details. 38 | #' 39 | #' @param chk.sm.pt Logical; should the edges be checked to see if any of them 40 | #' start and end on the same axis with the same radius? See Details. 41 | #' 42 | #' @param chk.ax.jump Logical; should the edges be checked to see if any of 43 | #' them start and end on non-adjacent axes, e.g. axis 1 --> axis 3? See 44 | #' Details. 45 | # " 46 | #' @param chk.sm.ax Logical; should the edges be checked to see if any of them 47 | #' start and end on the same axis? 48 | #' 49 | #' @param chk.virtual.edge Logical; should the edges be checked to see if any of them 50 | #' start and end on different nodes which happen to be at the same radius on the 51 | #' same axis? See Details. 52 | #' 53 | #' @param chk.orphan.node Logical; should orphan nodes be identifed? Orphan 54 | #' nodes have degree 0 (no incoming or outgoing edges). 55 | #' 56 | #' @param plot.list Logical; should a data frame of edges to be drawn be 57 | #' returned? 58 | #' 59 | #' @param tex Logical; should the \code{plot.list} be formatted for LaTeX? 60 | #' 61 | #' @param orphan.list Logical; should a data frame of orphaned nodes be 62 | #' returned? 63 | #' 64 | #' @return A summary of the \code{HivePlotData} object's key characteristics is 65 | #' printed at the console, followed by the results of any checks set to 66 | #' \code{TRUE}. The format of these results is identical to that of 67 | #' \code{plot.list} described just below, except for the orphan node check. 68 | #' This is formatted the same as \code{HPD$nodes}; see \code{?HPD} for details. 69 | #' 70 | #' If \code{plot.list = TRUE}, a data frame containing a list of the 71 | #' edges to be drawn in a format suitable for troubleshooting a plot. If 72 | #' \code{tex = TRUE} as well, the data frame will be in a format suitable for 73 | #' pasting into a LaTeX document. The data frame will contain rows describing 74 | #' each edge to be drawn with the following columns: node 1 id, node 1 axis, 75 | #' node 1 label, node 1 radius, then the same info for node 2, then the edge 76 | #' weight and the edge color. 77 | #' 78 | #' If \code{orphan.list = TRUE} a data frame 79 | #' giving the orphan nodes is returned. If you want both \code{plot.list} and 80 | #' \code{orphan.list} you have to call this function twice. 81 | #' 82 | #' @author Bryan A. Hanson, DePauw University. \email{hanson@@depauw.edu} 83 | #' 84 | #' @keywords utilities 85 | #' 86 | #' @export sumHPD 87 | #' 88 | #' @importFrom plyr count 89 | #' 90 | #' @examples 91 | #' 92 | #' set.seed(55) 93 | #' test <- ranHiveData(nx = 4, ne = 5, desc = "Tiny 4D data set") 94 | #' out <- sumHPD(test, chk.all = TRUE, plot.list = TRUE) 95 | #' print(out) 96 | sumHPD <- function(HPD, chk.all = FALSE, chk.sm.pt = FALSE, chk.ax.jump = FALSE, 97 | chk.sm.ax = FALSE, chk.orphan.node = FALSE, chk.virtual.edge = FALSE, 98 | plot.list = FALSE, tex = FALSE, orphan.list = FALSE) { 99 | 100 | # Function to summarize objects of S3 class 'HivePlotData' 101 | # Part of HiveR package 102 | # Bryan Hanson, DePauw Univ, Oct 2011 103 | 104 | 105 | chkHPD(HPD) # verify it's legit 106 | 107 | # Overall summary 108 | na <- length(unique(HPD$nodes$axis)) 109 | 110 | cat("\t", HPD$desc, "\n", sep = "") 111 | cat("\tThis hive plot data set contains ", 112 | length(HPD$nodes$id), " nodes on ", 113 | na, " axes and ", 114 | length(HPD$edges$id1), " edges.\n", 115 | sep = "" 116 | ) 117 | cat("\tIt is a ", HPD$type, " data set.\n\n", sep = "") 118 | 119 | # Now summarize the axes and nodes 120 | 121 | nodes <- HPD$nodes 122 | 123 | for (n in sort(unique(nodes$axis))) { 124 | g <- nodes[nodes[, "axis"] == n, ] 125 | # g <- subset(nodes, axis == n) 126 | cat("\t\tAxis", n, "has", length(g$id), "nodes spanning radii from", 127 | min(g$radius), "to", max(g$radius), "\n", 128 | sep = " " 129 | ) 130 | } 131 | 132 | # Create a list of edges to be drawn (used for several chks) 133 | 134 | n1.lab <- n1.rad <- n2.lab <- n2.rad <- n1.ax <- n2.ax <- c() 135 | 136 | for (n in 1:(length(HPD$edges$id1))) { 137 | pat1 <- HPD$edges$id1[n] 138 | pat2 <- HPD$edges$id2[n] 139 | pat1 <- paste("\\b", pat1, "\\b", sep = "") # ensures exact match 140 | pat2 <- paste("\\b", pat2, "\\b", sep = "") 141 | i1 <- grep(pat1, HPD$nodes$id) 142 | i2 <- grep(pat2, HPD$nodes$id) 143 | n1.lab <- c(n1.lab, HPD$nodes$lab[i1]) 144 | n2.lab <- c(n2.lab, HPD$nodes$lab[i2]) 145 | n1.rad <- c(n1.rad, HPD$nodes$radius[i1]) 146 | n2.rad <- c(n2.rad, HPD$nodes$radius[i2]) 147 | n1.ax <- c(n1.ax, HPD$nodes$axis[i1]) 148 | n2.ax <- c(n2.ax, HPD$nodes$axis[i2]) 149 | } 150 | 151 | fd <- data.frame( 152 | n1.id = HPD$edges$id1, 153 | n1.ax, 154 | n1.lab, 155 | n1.rad, 156 | n2.id = HPD$edges$id2, 157 | n2.ax, 158 | n2.lab, 159 | n2.rad, 160 | e.wt = HPD$edges$weight, 161 | e.col = HPD$edges$color 162 | ) 163 | 164 | # Now summarize edges by axis pair 165 | 166 | fd2 <- fd[, c(2, 6)] 167 | fd2 <- plyr::count(fd2, vars = c("n1.ax", "n2.ax")) 168 | cat("\n") 169 | for (n in 1:nrow(fd2)) { 170 | cat("\t\tAxes", fd2$n1.ax[n], "and", fd2$n2.ax[n], "share", fd2$freq[n], "edges\n", sep = " ") 171 | } 172 | cat("\n") 173 | 174 | ##### Done with default basic summary ##### 175 | 176 | # Perform the additional requested checks 177 | 178 | if (chk.all) { 179 | chk.sm.pt <- TRUE 180 | chk.virtual.edge <- TRUE 181 | chk.ax.jump <- TRUE 182 | chk.sm.ax <- TRUE 183 | chk.orphan.node <- TRUE 184 | } 185 | 186 | # Note: both chk.sm.pt and chk.virtual.edge identify conditions 187 | # corresponding to zero length edges, they just have different origins. 188 | 189 | if (chk.sm.pt) { 190 | prob <- which(fd$n1.id == fd$n2.id) 191 | if (length(prob) == 0) cat("\n\tNo edges starting and ending on the same node were found\n") 192 | if (length(prob) > 0) { 193 | cat("\n\n\tThe following edges start and end at the same node and the\n\tcorresponding nodes should be deleted, offset or\n\tjittered (or the edge deleted) before plotting:\n\n") 194 | print(fd[prob, ], row.names = FALSE) 195 | } 196 | } 197 | 198 | if (chk.virtual.edge) { 199 | prob1 <- which((fd$n1.rad == fd$n2.rad) & (fd$n1.ax == fd$n2.ax)) 200 | prob2 <- which(fd$n1.id == fd$n2.id) # drop those caught by chk.sm.pt 201 | prob <- setdiff(prob1, prob2) 202 | if (length(prob) == 0) cat("\n\tNo virtual edges were found\n") 203 | if (length(prob) > 0) { 204 | cat("\n\n\tThe following (virtual) edges start and end at the \n\tsame radius on the same axis and the\n\tcorresponding nodes should be deleted, offset or\n\tjittered (or the edge deleted) before plotting:\n\n") 205 | print(fd[prob, ], row.names = FALSE) 206 | } 207 | } 208 | 209 | if (chk.sm.ax) { 210 | prob <- which(fd$n1.ax == fd$n2.ax) 211 | if (length(prob) == 0) cat("\n\tNo edges were found that start and end on the same axis\n") 212 | if (length(prob) > 0) { 213 | cat("\n\n\tThe following edges start and end on the same axis:\n\n") 214 | print(fd[prob, ], row.names = FALSE) 215 | } 216 | } 217 | 218 | if (chk.orphan.node) { 219 | e.ids <- union(HPD$edges$id1, HPD$edges$id2) 220 | n.ids <- HPD$nodes$id 221 | prob <- setdiff(n.ids, e.ids) 222 | prob <- match(prob, HPD$nodes$id) 223 | if (length(prob) == 0) cat("\n\tNo orphaned nodes were found\n") 224 | if (length(prob) > 0) { 225 | cat("\n\n\tThe following", length(prob), "nodes are orphaned (degree = 0):\n\n") 226 | print(HPD$nodes[prob, ], row.names = FALSE) 227 | orphans <- HPD$nodes[prob, ] 228 | } 229 | } 230 | 231 | if (chk.ax.jump) { 232 | prob <- which( 233 | ((fd$n1.ax == 1) & (fd$n2.ax == 3)) & 234 | ((fd$n1.ax == 2) & (fd$n2.ax == 4)) & 235 | ((fd$n1.ax == 3) & (fd$n2.ax == 5)) & 236 | ((fd$n1.ax == 4) & (fd$n2.ax == 6)) & 237 | ((fd$n1.ax == 5) & (fd$n2.ax == 1)) & 238 | ((fd$n1.ax == 6) & (fd$n2.ax == 2)) & 239 | # 240 | ((fd$n1.ax == 6) & (fd$n2.ax == 4)) & 241 | ((fd$n1.ax == 5) & (fd$n2.ax == 3)) & 242 | ((fd$n1.ax == 4) & (fd$n2.ax == 2)) & 243 | ((fd$n1.ax == 3) & (fd$n2.ax == 1)) & 244 | ((fd$n1.ax == 2) & (fd$n2.ax == 6)) & 245 | ((fd$n1.ax == 1) & (fd$n2.ax == 5)) 246 | ) 247 | 248 | if (length(prob) == 0) cat("\n\tNo edges that jump axes were found\n") 249 | if (length(prob) > 0) { 250 | cat("\n\n\tThe following edges jump over an axis (and won't be drawn):\n\n") 251 | print(fd[prob, ], row.names = FALSE) 252 | } 253 | } 254 | 255 | if ((tex) & (plot.list)) { 256 | if (!requireNamespace("xtable", quietly = TRUE)) { 257 | stop("To use option tex you need to install package xtable") 258 | } 259 | fd <- xtable::xtable(fd, hline.after = c(1), include.rownames = FALSE) 260 | xtable::align(fd) <- "|r|rrlr|rrlr|rl|" 261 | } 262 | 263 | if (plot.list) { 264 | return(fd) 265 | } # user must not ask for both at the same time! 266 | if (orphan.list) { 267 | return(orphans) 268 | } 269 | } 270 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## How to install HiveR 2 | 3 | ### From CRAN using R: 4 | 5 | ````r 6 | chooseCRANmirror() # choose a CRAN mirror 7 | install.packages("HiveR") 8 | library("HiveR") 9 | ```` 10 | 11 | ### To install from Github using R: 12 | 13 | ````r 14 | install.packages("remotes") 15 | library("remotes") 16 | install_github(repo = "bryanhanson/HiveR@main") 17 | library("HiveR") 18 | ```` 19 | 20 | If you use `@some_other_branch` you can get other branches that might be available. They may or may not pass CRAN checks and thus may not install automatically using the method above. Check the NEWS file to see what's up. 21 | 22 | ### License Information 23 | 24 | HiveR is distributed under the GPL-3 license, as stated in the DESCRIPTION file. For more info, see the [GPL site.](https://gnu.org/licenses/gpl.html) 25 | 26 | Questions? hanson@depauw.edu 27 | -------------------------------------------------------------------------------- /data/Arroyo.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/data/Arroyo.RData -------------------------------------------------------------------------------- /data/HEC.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/data/HEC.RData -------------------------------------------------------------------------------- /data/Safari.RData: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/data/Safari.RData -------------------------------------------------------------------------------- /inst/extdata/E_coli/EdgeInst_P.csv: -------------------------------------------------------------------------------- 1 | dot.tag,dot.val,hive.tag,hive.val type,0,color,grey type,1,color,yellow type,2,color,orange type,3,color,red 2 | -------------------------------------------------------------------------------- /inst/extdata/E_coli/EdgeInst_TF.csv: -------------------------------------------------------------------------------- 1 | dot.tag,dot.val,hive.tag,hive.val interaction,repressor,color,red interaction,activator,color,green interaction,dual,color,orange 2 | -------------------------------------------------------------------------------- /inst/extdata/E_coli/NodeInst_P.csv: -------------------------------------------------------------------------------- 1 | dot.tag,dot.val,hive.tag,hive.val label,persistent,color,red label,nonpersistent,color,black 2 | -------------------------------------------------------------------------------- /inst/extdata/E_coli/NodeLabels_P.csv: -------------------------------------------------------------------------------- 1 | node.lab,node.text,angle,radius,offset,hjust,vjust dnaa,dnaa,45,1,0,1.1,0 -------------------------------------------------------------------------------- /inst/extdata/E_coli/README: -------------------------------------------------------------------------------- 1 | Summary of E coli files in inst/extdata/E_coli 2 | 3 | Part of HiveR package by Bryan Hanson. Files provided by Martin Krzywinski of the Genome Sciences Center and used with permission. 4 | 5 | ***** 6 | 7 | The main source of data for the regulatory network is: 8 | 9 | Gama-Castro S, Salgado H, Peralta-Gil M, Santos-Zavaleta A, Muniz-Rascado 10 | L, Solano-Lira H et al (2011). RegulonDB version 7.0: transcriptional 11 | regulation of Escherichia coli K-12 integrated within genetic sensory 12 | response units (Gensor Units). Nucleic Acids Research 39: D98-D105. 13 | 14 | http://www.ncbi.nlm.nih.gov/pubmed/21051347?dopt=Abstract 15 | 16 | ***** 17 | 18 | The files Ecoli_P.dot, EdgeInst_P.csv, NodeInst_P.csv and NodeLabels_P.csv pertain to the gene regulatory network of E. coli as discussed in: 19 | 20 | Yan KK, Fang G, Bhardwaj N, Alexander RP, Gerstein M. 2010. Comparing genomes to computer operating systems in terms of the topology and evolution of their regulatory control networks. Proc Natl Acad Sci U S A 107(20): 9186-9191. 21 | 22 | This data set has been extended by Martin Krzywinski by the addition of persistence and edge classifiers as described below. 23 | 24 | Nodes are classified as 'persistent' or 'nonpersistent' according to the definition in the original paper (Yan et al). Edges are classified using a type=N label where N=0,1,2,3 defined as follows. For E. coli 25 | 26 | type=0 - E. coli gene names share 0 common start characters (crp acea) 27 | type=1 - E. coli gene names share 1 common start characters (arca acee) 28 | type=2 - E. coli gene names share 2 common start characters (argr arti) 29 | type=3 - E. coli gene names share 3 common start characters (acrr acrb) 30 | 31 | ***** 32 | 33 | The files Ecoli_TF.dot and EdgeInst_TF.csv are from an more recent version of RegulonDB; the edges are coded according to whether the transcription factor is an activator, repressor, or dual function protein. There are no node instructions for the transcription factor data set. -------------------------------------------------------------------------------- /inst/extdata/Misc/BlueEye.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/inst/extdata/Misc/BlueEye.jpg -------------------------------------------------------------------------------- /inst/extdata/Misc/BrownEye.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/inst/extdata/Misc/BrownEye.jpg -------------------------------------------------------------------------------- /inst/extdata/Misc/GreenEye.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/inst/extdata/Misc/GreenEye.jpg -------------------------------------------------------------------------------- /inst/extdata/Misc/HECgraphics.txt: -------------------------------------------------------------------------------- 1 | node.lab, angle, radius, offset, width, path 2 | eye_33, 105, 2.25, 0.2, 0.75,"GreenEye.jpg" 3 | eye_37, 115, 2.0, 0.2, 0.75,"HazelEye.jpg" 4 | eye_41, 125, 1.5, 0.2, 0.75,"BlueEye.jpg" 5 | eye_45, 135, 0.0, 0.0, 0.75,"BrownEye.jpg" 6 | -------------------------------------------------------------------------------- /inst/extdata/Misc/HECnodes.txt: -------------------------------------------------------------------------------- 1 | node.lab,node.text,angle,radius,offset,hjust,vjust 2 | eye_33, "green", 240, 2.5, 0.2, 0.5, 0.5 3 | eye_37, "hazel", 240, 2.5, 0.2, 0.5, 0.5 4 | eye_41, "blue", 240, 2.5, 0.2, 0.5, 0.5 5 | eye_45, "brown", 240, 2.5, 0.2, 0.5, 0.5 6 | hair_1, "black", 60, 2.0, 0.2, 0.5, 0.5 7 | hair_2, "brown", 60, 2.0, 0.2, 0.5, 0.5 8 | hair_3, "red", 60, 2.0, 0.2, 0.5, 0.5 9 | hair_4, "blond", 60, 2.0, 0.2, 0.5, 0.5 10 | -------------------------------------------------------------------------------- /inst/extdata/Misc/HECticks.txt: -------------------------------------------------------------------------------- 1 | node.lab,node.text,angle,radius,offset,hjust,vjust 2 | eye_33, 1, 90, 0.25, 0.2, 0.5, 0.5 3 | eye_37, 2, 90, 0.25, 0.2, 0.5, 0.5 4 | eye_41, 3, 90, 0.25, 0.2, 0.5, 0.5 5 | eye_45, 4, 90, 0.25, 0.2, 0.5, 0.5 6 | hair_1, , 270, 0.25, 0.2, 0.5, 0.5 7 | hair_2, , 270, 0.25, 0.2, 0.5, 0.5 8 | hair_3, , 270, 0.245, 0.2, 0.5, 0.5 9 | hair_4, , 270, 0.25, 0.2, 0.5, 0.5 10 | -------------------------------------------------------------------------------- /inst/extdata/Misc/HazelEye.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bryanhanson/HiveR/d21c30b9aac03f3ae0672a61231850ce407378df/inst/extdata/Misc/HazelEye.jpg -------------------------------------------------------------------------------- /inst/extdata/Misc/README: -------------------------------------------------------------------------------- 1 | 2 | ### Misc Files for use with HiveR 3 | 4 | The image files here were derived from those available in Wikipedia Commons and are under the Creative Commons license (https://creativecommons.org/licenses/by-sa/3.0/deed.en) 5 | 6 | -------------------------------------------------------------------------------- /man/Arroyo.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Arroyo.R 3 | \docType{data} 4 | \name{Arroyo} 5 | \alias{Arroyo} 6 | \alias{Safari} 7 | \title{Plant-Pollinator Data Sets in Hive Plot Data Format} 8 | \description{ 9 | Plant-pollinator data sets which were derived ultimately from Vasquez and 10 | Simberloff, 2003. These are two-trophic level systems that have almost 11 | exactly the same plants and pollinators. \code{Safari} is from an 12 | undisturbed area, while \code{Arroyo} is from a nearby location grazed by 13 | cattle. In the original publication, the data sets are called Safariland 14 | and Arroyo Goye. See Details for how the original data was converted. 15 | } 16 | \details{ 17 | These data sets are \code{\link{HivePlotData}} objects. They were created 18 | from the datasets \code{Safariland} and \code{vazarr} in the package 19 | \code{bipartite}. The process was the same for each: 1. Plants were placed 20 | on one axis, pollinators on the other. 2. A radius was assigned by 21 | calculating d' using function \code{dfun} in package \code{bipartite}. d' 22 | is an index of specialization; higher values mean the plant or pollinator is 23 | more specialized. 3. Edge weights were assigned proportional to the square 24 | root of the normalized number of visits of a pollinator to a plant. Thus 25 | the width of the edge drawn is an indication of the visitation rate. 4. 26 | The number of visits were divided manually into 4 groups and used to assign 27 | edge colors ranging from white to red. The redder colors represent greater 28 | numbers of visits, and the color-coding is comparable for each data set. 29 | } 30 | \author{ 31 | Bryan A. Hanson, DePauw University, Greencastle Indiana USA 32 | } 33 | \keyword{datasets} 34 | -------------------------------------------------------------------------------- /man/HEC.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/HEC.R 3 | \docType{data} 4 | \name{HEC} 5 | \alias{HEC} 6 | \title{A HivePlotData Object of the Hair Eye Color Data Set} 7 | \format{ 8 | The format is described in detail at \code{\link{HPD}}. 9 | } 10 | \description{ 11 | This is an \code{\link{HPD}} (\code{HivePlotData} object) derived from the 12 | built-in hair eye color data set (see \code{?HairEyeColor}). It serves as a 13 | test 2D data set, and the example below shows how it was built. While every 14 | data set is different and will require a different approach, the example 15 | illustrates the general approach to building a hive plot from scratch, 16 | step-by-step. 17 | } 18 | \examples{ 19 | 20 | # An example of building an HPD from scratch 21 | 22 | ### Step 0. Get to know your data. 23 | 24 | data(HairEyeColor) # see ?HairEyeColor for background 25 | df <- data.frame(HairEyeColor) # str(df) is useful 26 | 27 | # Frequencies of the colors can be found with: 28 | eyeF <- aggregate(Freq ~ Eye, data = df, FUN = "sum") 29 | hairF <- aggregate(Freq ~ Hair, data = df, FUN = "sum") 30 | es <- eyeF$Freq / eyeF$Freq[4] # node sizes for eye 31 | hs <- hairF$Freq / hairF$Freq[3] # node sizes for hair 32 | 33 | ### Step 1. Assemble a data frame of the nodes. 34 | 35 | # There are 32 rows in the data frame, but we are going to 36 | # separate the hair color from the eye color and thus 37 | # double the number of rows in the node data frame 38 | 39 | nodes <- data.frame( 40 | id = 1:64, 41 | lab = paste(rep(c("hair", "eye"), each = 32), 1:64, sep = "_"), 42 | axis = rep(1:2, each = 32), 43 | radius = rep(NA, 64) 44 | ) 45 | 46 | for (n in 1:32) { 47 | # assign node radius based most common colors 48 | if (df$Hair[n] == "Black") nodes$radius[n] <- 2 49 | if (df$Hair[n] == "Brown") nodes$radius[n] <- 4 50 | if (df$Hair[n] == "Red") nodes$radius[n] <- 1 51 | if (df$Hair[n] == "Blond") nodes$radius[n] <- 3 52 | 53 | if (df$Eye[n] == "Brown") nodes$radius[n + 32] <- 1 54 | if (df$Eye[n] == "Blue") nodes$radius[n + 32] <- 2 55 | if (df$Eye[n] == "Hazel") nodes$radius[n + 32] <- 3 56 | if (df$Eye[n] == "Green") nodes$radius[n + 32] <- 4 57 | 58 | # now do node sizes 59 | if (df$Hair[n] == "Black") nodes$size[n] <- hs[1] 60 | if (df$Hair[n] == "Brown") nodes$size[n] <- hs[2] 61 | if (df$Hair[n] == "Red") nodes$size[n] <- hs[3] 62 | if (df$Hair[n] == "Blond") nodes$size[n] <- hs[4] 63 | 64 | if (df$Eye[n] == "Brown") nodes$size[n + 32] <- es[4] 65 | if (df$Eye[n] == "Blue") nodes$size[n + 32] <- es[3] 66 | if (df$Eye[n] == "Hazel") nodes$size[n + 32] <- es[2] 67 | if (df$Eye[n] == "Green") nodes$size[n + 32] <- es[1] 68 | } 69 | 70 | nodes$color <- rep("black", 64) 71 | nodes$lab <- as.character(nodes$lab) # clean up some data types 72 | nodes$radius <- as.numeric(nodes$radius) 73 | 74 | ### Step 2. Assemble a data frame of the edges. 75 | 76 | edges <- data.frame( # There will be 32 edges, corresponding to the original 32 rows 77 | id1 = c(1:16, 49:64), # This will set up edges between each eye/hair pair 78 | id2 = c(33:48, 17:32), # & put the males above and the females below 79 | weight = df$Freq, 80 | color = rep(c("lightblue", "pink"), each = 16) 81 | ) 82 | 83 | edges$color <- as.character(edges$color) 84 | 85 | # Scale the edge weight (det'd by trial & error to emphasize differences) 86 | edges$weight <- 0.25 * log(edges$weight)^2.25 87 | 88 | ### Step 3. Now assemble the HivePlotData (HPD) object. 89 | 90 | HEC <- list() 91 | HEC$nodes <- nodes 92 | HEC$edges <- edges 93 | HEC$type <- "2D" 94 | HEC$desc <- "HairEyeColor data set" 95 | HEC$axis.cols <- c("grey", "grey") 96 | class(HEC) <- "HivePlotData" 97 | 98 | ### Step 4. Check it & summarize 99 | 100 | chkHPD(HEC) # answer of FALSE means there are no problems 101 | sumHPD(HEC) 102 | 103 | ### Step 5. Plot it. 104 | 105 | # A minimal plot 106 | plotHive(HEC, ch = 0.1, bkgnd = "white") 107 | # See ?plotHive for fancier options 108 | } 109 | \keyword{datasets} 110 | -------------------------------------------------------------------------------- /man/HidingAnAxis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/HidingAnAxis.R 3 | \name{HidingAnAxis} 4 | \alias{HidingAnAxis} 5 | \alias{TwoPlotsOnePage} 6 | \title{How to Hide An Axis in a Hive Plot, with Bonus 2 Plots on One Page} 7 | \description{ 8 | From time-to-time is useful to compare several hive plots based on related 9 | data (and you might wish to plot them side-by-side to facilitate 10 | comparison). Depending the nature of the data set and how it changes under 11 | the experimental design, some data sets may not have any nodes on a 12 | particular axis (and therefore, they don't participate in edges either). 13 | Let's say your system fundamentally has three axes, but in some data sets 14 | one of the axes has no nodes. When you plot them side-by-side, for visual 15 | comparison it is nice if all the plots, including the one with an empty 16 | axis, have the same general orientation. In other words, even if the data 17 | only requires two axes, you might want it plotted as if it had three axes 18 | for consistency in overall appearance. 19 | } 20 | \details{ 21 | When an axis is present but doesn't have a node on it, this makes 22 | \code{plotHive} unhappy, but there is a simple solution. You simply put a 23 | dummy or phantom node on the empty axis. This is illustrated in the example 24 | below. Also demonstrated is a simple \code{grid}-based function for putting 25 | more than one plot on a device. 26 | } 27 | \examples{ 28 | 29 | require("grid") 30 | 31 | # Adjacency matrix describing the connectivity in 2-butanone 32 | # H's on a single carbon collapsed into a group. 33 | # Matrix entry is bond order. CH3 is coded so the 34 | # bond order between C & H is 3 (3 single C-H bonds) 35 | 36 | dnames <- c("C1", "C2", "C3", "C4", "O", "HC1", "HC3", "HC4") 37 | 38 | # C1, C2, C3, C4, O, HC1, HC3, HC4 39 | butanone <- matrix(c( 40 | 0, 1, 0, 0, 0, 3, 0, 0, # C1 41 | 1, 0, 1, 0, 2, 0, 0, 0, # C2 42 | 0, 1, 0, 1, 0, 0, 2, 0, # C3 43 | 0, 0, 1, 0, 0, 0, 0, 3, # C4 44 | 0, 2, 0, 0, 0, 0, 0, 0, # O 45 | 3, 0, 0, 0, 0, 0, 0, 0, # HC1 46 | 0, 0, 2, 0, 0, 0, 0, 0, # HC3 47 | 0, 0, 0, 3, 0, 0, 0, 0 48 | ), # HC4 49 | ncol = 8, byrow = TRUE, 50 | dimnames = list(dnames, dnames) 51 | ) 52 | 53 | butanoneHPD <- adj2HPD( 54 | M = butanone, axis.col = c("black", "gray", "red"), 55 | desc = "2-butanone" 56 | ) 57 | 58 | # Fix up the nodes manually (carbon is on axis 1) 59 | butanoneHPD$nodes$axis[5] <- 3L # oxygen on axis 3 60 | butanoneHPD$nodes$axis[6:8] <- 2L # hydrogen on axis 2 61 | butanoneHPD$nodes$color[5] <- "red" 62 | butanoneHPD$nodes$color[6:8] <- "gray" 63 | 64 | # Exaggerate the edge weights, which are proportional to the number of bonds 65 | butanoneHPD$edges$weight <- butanoneHPD$edges$weight^2 66 | butanoneHPD$edges$color <- rep("wheat3", 7) 67 | 68 | plotHive(butanoneHPD, 69 | method = "rank", bkgnd = "white", 70 | axLabs = c("carbon", "hydrogen", "oxygen"), 71 | axLab.pos = c(1, 1, 1), axLab.gpar = 72 | gpar(col = c("black", "gray", "red")) 73 | ) 74 | 75 | # Now repeat the process for butane 76 | 77 | dnames <- c("C1", "C2", "C3", "C4", "HC1", "HC2", "HC3", "HC4") 78 | 79 | # C1, C2, C3, C4, HC1, HC2, HC3, HC4 80 | butane <- matrix(c( 81 | 0, 1, 0, 0, 3, 0, 0, 0, # C1 82 | 1, 0, 1, 0, 0, 2, 0, 0, # C2 83 | 0, 1, 0, 1, 0, 0, 2, 0, # C3 84 | 0, 0, 1, 0, 0, 0, 0, 3, # C4 85 | 3, 0, 0, 0, 0, 0, 0, 0, # HC1 86 | 0, 2, 0, 0, 0, 0, 0, 0, # HC2 87 | 0, 0, 2, 0, 0, 0, 0, 0, # HC3 88 | 0, 0, 0, 3, 0, 0, 0, 0 89 | ), # HC4 90 | ncol = 8, byrow = TRUE, 91 | dimnames = list(dnames, dnames) 92 | ) 93 | 94 | butaneHPD <- adj2HPD( 95 | M = butane, axis.col = c("black", "gray"), 96 | desc = "butane" 97 | ) 98 | butaneHPD$nodes$axis[5:8] <- 2L # hydrogen on axis 2 99 | butaneHPD$nodes$color[5:8] <- "gray" 100 | butaneHPD$edges$weight <- butaneHPD$edges$weight^2 101 | butaneHPD$edges$color <- rep("wheat3", 7) 102 | 103 | plotHive(butaneHPD, 104 | method = "rank", bkgnd = "white", 105 | axLabs = c("carbon", "hydrogen"), 106 | axLab.pos = c(1, 1), axLab.gpar = gpar(col = c("black", "gray")) 107 | ) 108 | 109 | # butaneHPD has 2 axes. If we wanted to compare to butanoneHPD effectively 110 | # we should add a third dummy axis where the oxygen axis was in butanone 111 | # You might want to look at str(butaneHPD) before beginning 112 | 113 | dummy <- c(9, "dummy", 3, 1.0, 1.0, "white") # mixed data types 114 | # but coerced to character 115 | butaneHPD$nodes <- rbind(butaneHPD$nodes, dummy) 116 | str(butaneHPD$nodes) # The data types are mangled from the rbind! 117 | 118 | # Now coerce the data types to the standard of the class, and check it 119 | butaneHPD$nodes$id <- as.integer(butaneHPD$nodes$id) 120 | butaneHPD$nodes$axis <- as.integer(butaneHPD$nodes$axis) 121 | butaneHPD$nodes$radius <- as.numeric(butaneHPD$nodes$radius) 122 | butaneHPD$nodes$size <- as.numeric(butaneHPD$nodes$size) 123 | str(butaneHPD$nodes) 124 | 125 | chkHPD(butaneHPD) # OK! (False means there were no problems) 126 | sumHPD(butaneHPD) 127 | 128 | # Plot it 129 | 130 | plotHive(butaneHPD, 131 | method = "rank", bkgnd = "white", 132 | axLabs = c("carbon", "hydrogen", "oxygen"), 133 | axLab.pos = c(1, 1, 1), axLab.gpar = 134 | gpar(col = c("black", "gray", "red")) 135 | ) 136 | 137 | # Put 2 plots side-by-side using a little helper function 138 | 139 | vplayout <- function(x, y) viewport(layout.pos.row = x, layout.pos.col = y) 140 | 141 | # pdf("Demo.pdf", width = 10, height = 5) # Aspect ratio better 142 | # default screen device 143 | 144 | grid.newpage() 145 | pushViewport(viewport(layout = grid.layout(1, 2))) 146 | pushViewport(vplayout(1, 1)) # left plot 147 | 148 | plotHive(butanoneHPD, 149 | method = "rank", bkgnd = "white", 150 | axLabs = c("carbon", "hydrogen", "oxygen"), 151 | axLab.pos = c(1, 1, 1), axLab.gpar = 152 | gpar(col = c("black", "gray", "red")), np = FALSE 153 | ) 154 | grid.text("butanone", 155 | x = 0.5, y = 0.1, default.units = "npc", 156 | gp = gpar(fontsize = 14, col = "black") 157 | ) 158 | 159 | popViewport(2) 160 | pushViewport(vplayout(1, 2)) # right plot 161 | grid.text("test2") 162 | 163 | plotHive(butaneHPD, 164 | method = "rank", bkgnd = "white", 165 | axLabs = c("carbon", "hydrogen", "oxygen"), 166 | axLab.pos = c(1, 1, 1), axLab.gpar = 167 | gpar(col = c("black", "gray", "red")), np = FALSE 168 | ) 169 | grid.text("butane", 170 | x = 0.5, y = 0.1, default.units = "npc", 171 | gp = gpar(fontsize = 14, col = "black") 172 | ) 173 | 174 | # dev.off() 175 | } 176 | \author{ 177 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 178 | } 179 | -------------------------------------------------------------------------------- /man/HivePlotData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/HivePlotData.R 3 | \name{HivePlotData} 4 | \alias{HivePlotData} 5 | \alias{HPD} 6 | \title{Hive Plot Data Objects} 7 | \description{ 8 | In package \code{HiveR}, hive plot data sets are stored as an S3 class 9 | called \code{HivePlotData}, detailed below. 10 | } 11 | \note{ 12 | While \code{$edges$id1} and \code{$edges$id2} are defined as the 13 | starting and ending nodes of a particular edge, hive plots as currently 14 | implemented are not directed graphs (agnostic might be a better word). \cr 15 | \cr \code{HPD$type} indicates the type of hive data: If \code{2D}, then the 16 | data is intended to be plotted with \code{hivePlot} which is a 2D plot with 17 | axes radially oriented, and (hopefully) no edges that cross axes. If 18 | \code{3D}, then the data is intended to be plotted with \code{plot3dHive} 19 | which gives an interactive 3D plot, with axes oriented in 3D. 20 | } 21 | \section{Structure}{ 22 | The structure of a \code{HivePlotData} object is a list 23 | of 6 elements, some of which are data frames, and an attribute, as follows: 24 | 25 | \tabular{llll}{ 26 | \emph{element} \tab \emph{(element)} \tab \emph{type} \tab \emph{description}\cr 27 | $nodes \tab \tab data frame \tab Data frame of node properties \cr 28 | \tab $id \tab int \tab Node identifier \cr 29 | \tab $lab \tab chr \tab Node label \cr 30 | \tab $axis \tab int \tab Axis to which node is assigned \cr 31 | \tab $radius \tab num \tab Radius (position) of node along the axis \cr 32 | \tab $size \tab num \tab Node size in pixels \cr 33 | \tab $color \tab chr \tab Node color \cr 34 | $edges \tab \tab data frame \tab Data frame of edge properties \cr 35 | \tab $id1 \tab int \tab Starting node id \cr 36 | \tab $id2 \tab int \tab Ending node id \cr 37 | \tab $weight \tab num \tab Width of edge in pixels \cr 38 | \tab $color \tab chr \tab Edge color \cr 39 | $type \tab \tab chr \tab Type of hive. See Note. \cr 40 | $desc \tab \tab chr \tab Description of data \cr 41 | $axis.cols \tab \tab chr \tab Colors for axes \cr 42 | - attr \tab \tab chr "HivePlotData" \tab The S3 class designation.\cr } 43 | } 44 | 45 | \examples{ 46 | 47 | test4 <- ranHiveData(nx = 4) 48 | str(test4) 49 | sumHPD(test4) 50 | plotHive(test4) 51 | } 52 | \seealso{ 53 | \code{\link{sumHPD}} to summarize a \code{HivePlotData} object.\cr 54 | \code{\link{chkHPD}} to verify the integrity of a \code{HivePlotData} 55 | object.\cr \code{\link{ranHiveData}} to generate random \code{HivePlotData} 56 | objects for testing and demonstration. 57 | } 58 | \author{ 59 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 60 | } 61 | \keyword{classes} 62 | -------------------------------------------------------------------------------- /man/HiveR-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/HiveR-package.R 3 | \docType{package} 4 | \name{HiveR-package} 5 | \alias{HiveR-package} 6 | \alias{HiveR} 7 | \title{2D and 3D Hive Plots for R} 8 | \description{ 9 | Creates and plots 2D and 3D hive plots. Hive plots are a unique method of 10 | displaying networks of many types in which node properties are mapped to 11 | axes using meaningful properties rather than being arbitrarily positioned. 12 | The hive plot concept was invented by Martin Krzywinski at the Genome 13 | Science Center (www.hiveplot.net/). Keywords: networks, food webs, linnet, 14 | systems biology, bioinformatics. 15 | } 16 | \seealso{ 17 | Useful links: 18 | \itemize{ 19 | \item \url{https://github.com/bryanhanson/HiveR} 20 | \item Report bugs at \url{https://github.com/bryanhanson/HiveR/issues} 21 | } 22 | 23 | } 24 | \author{ 25 | Bryan A. Hanson, DePauw University, Greencastle Indiana USA 26 | } 27 | \keyword{package} 28 | -------------------------------------------------------------------------------- /man/adj2HPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adj2HPD.R 3 | \name{adj2HPD} 4 | \alias{adj2HPD} 5 | \title{Process an Adjacency Graph into a HivePlotData Object} 6 | \usage{ 7 | adj2HPD(M = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{M}{A matrix with named dimensions. The names should be the node 11 | names. Should not be symmetric. If it is, only the lower triangle is used 12 | and a message is given.} 13 | 14 | \item{axis.cols}{A character vector giving the colors desired for the axes.} 15 | 16 | \item{type}{One of \code{c("2D", "3D")}. If \code{2D}, a 17 | \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 18 | be created and the eventual hive plot will be static and 2D. If \code{3D}, 19 | the \code{HivePlotData} object will be suitable for a 3D interactive plot 20 | using \code{\link{plot3dHive}}.} 21 | 22 | \item{desc}{Character. A description of the data set.} 23 | 24 | \item{\dots}{Other parameters to be passed downstream.} 25 | } 26 | \value{ 27 | A \code{ \link{HivePlotData}} object. 28 | } 29 | \description{ 30 | This function will take an adjacency graph and convert it into a basic 31 | \code{\link{HivePlotData}} object. Further manipulation by 32 | \code{\link{mineHPD}} will almost certainly be required before the data can 33 | be plotted. 34 | } 35 | \details{ 36 | This function produces a "bare bones" \code{HivePlotData} object. The names 37 | of the dimensions of \code{M} are used as the node names. All nodes are 38 | given size 1, an id number (\code{1:number of nodes}), are colored black and 39 | are assigned to axis 1. The edges are all gray, and the weight is M[i,j]. 40 | The user will likely have to manually make some changes to the resulting 41 | \code{HivePlotData} object before plotting. Alternatively, 42 | \code{\link{mineHPD}} may be able to extract some information buried in the 43 | data, but even then, the user will probably need to make some adjustments. 44 | See the examples. 45 | } 46 | \examples{ 47 | 48 | ### Example 1: a bipartite network 49 | ### Note: this first example has questionable scientific value! 50 | ### The purpose is to show how to troubleshoot and 51 | ### manipulate a HivePlotData object. 52 | 53 | if (require("bipartite")) { 54 | data(Safariland, package = "bipartite") # This is a bipartite network 55 | 56 | # You may wish to do ?Safariland or ?Safari for background 57 | 58 | hive1 <- adj2HPD(Safariland, desc = "Safariland data set from bipartite") 59 | sumHPD(hive1) 60 | 61 | # Note that all nodes are one axis with radius 1. Process further: 62 | 63 | hive2 <- mineHPD(hive1, option = "rad <- tot.edge.count") 64 | sumHPD(hive2) 65 | 66 | # All nodes still on 1 axis but degree has been used to set radius 67 | 68 | # Process further: 69 | 70 | hive3 <- mineHPD(hive2, option = "axis <- source.man.sink") 71 | sumHPD(hive3, chk.all = TRUE) 72 | 73 | # Note that mineHPD is generating some warnings, telling us 74 | # that the first 9 nodes were not assigned to an axis. Direct 75 | # inspection of the data shows that these nodes are insects 76 | # that did not visit any of the flowers in this particular study. 77 | 78 | # Pretty up a few things, then plot: 79 | 80 | hive3$edges$weight <- sqrt(hive3$edges$weight) * 0.5 81 | hive3$nodes$size <- 0.5 82 | plotHive(hive3) 83 | 84 | # This is a one-sided hive plot of 2 axes, which results 85 | # from the curvature of the splines. We can manually fix 86 | # this by reversing the ends of edges as follows: 87 | 88 | for (n in seq(1, length(hive3$edges$id1), by = 2)) { 89 | a <- hive3$edges$id1[n] 90 | b <- hive3$edges$id2[n] 91 | hive3$edges$id1[n] <- b 92 | hive3$edges$id2[n] <- a 93 | } 94 | 95 | plotHive(hive3) 96 | 97 | ### Example 2, a simple random adjacency matrix 98 | set.seed(31) 99 | nr <- 20 100 | nc <- 15 101 | M <- matrix(floor(runif(nc * nr, 0, 10)), ncol = nc) 102 | colnames(M) <- sample(c(letters, LETTERS), nc, replace = FALSE) 103 | rownames(M) <- sample(c(letters, LETTERS), nr, replace = FALSE) 104 | hive4 <- adj2HPD(M) 105 | sumHPD(hive4) 106 | } 107 | 108 | } 109 | \seealso{ 110 | \code{\link{dot2HPD}} and \code{\link{adj2HPD}} 111 | } 112 | \author{ 113 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} Vesna 114 | Memisevic contributed a fix that limited this function to bipartite networks 115 | (changed in v. 0.2-12). 116 | } 117 | \keyword{utilities} 118 | -------------------------------------------------------------------------------- /man/animateHive.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/animateHive.R 3 | \name{animateHive} 4 | \alias{animateHive} 5 | \title{Animate One or More 3D Hive Plots with a Handy Controller} 6 | \usage{ 7 | animateHive(hives = list(), cmds = list(), xy = 400, ...) 8 | } 9 | \arguments{ 10 | \item{hives}{A list of \code{HivePlotData} objects.} 11 | 12 | \item{cmds}{A list of arguments corresponding to how you want each hive 13 | plotted.} 14 | 15 | \item{xy}{An integer giving the size of the \code{rgl} window in pixels.} 16 | 17 | \item{\dots}{Other parameters to be passed downstream to \code{rgl}.} 18 | } 19 | \value{ 20 | None. Side effect is one or more plots. 21 | } 22 | \description{ 23 | This function takes a list of \code{HivePlotData} objects of \code{type = 24 | "3D"} and plots each in its own \code{rgl} window using its own arguments, 25 | then adds a controller which handles rotation and scaling. 26 | } 27 | \section{Warning}{ 28 | If you click the 'continue rotating' box on the controller 29 | window, be sure to unclick it and wait for the system to halt before closing 30 | any of the windows. If you close the controller w/o doing this, the 31 | remaining open windows with the hive plots will continue rotating endlessly 32 | and it seems you can't get their attention to close the windows. 33 | } 34 | 35 | \examples{ 36 | 37 | \dontrun{ 38 | require("rgl") 39 | # Sillyness: let's draw different hives with different settings 40 | # List of hives 41 | t4 <- ranHiveData(type = "3D", nx = 4) 42 | t5 <- ranHiveData(type = "3D", nx = 5) 43 | t6 <- ranHiveData(type = "3D", nx = 6) 44 | myhives <- list(t4, t5, t6) 45 | # List of arguments to plot in different coordinate systems 46 | cmd1 <- list(method = "abs", LA = TRUE, dr.nodes = FALSE, ch = 10) 47 | cmd2 <- list(method = "rank", LA = TRUE, dr.nodes = FALSE, ch = 2) 48 | cmd3 <- list(method = "norm", LA = TRUE, dr.nodes = FALSE, ch = 0.1) 49 | mycmds <- list(cmd1, cmd2, cmd3) 50 | # 51 | animateHive(hives = myhives, cmds = mycmds) 52 | } 53 | 54 | } 55 | \author{ 56 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 57 | } 58 | \keyword{interactive} 59 | -------------------------------------------------------------------------------- /man/chkHPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/chkHPD.R 3 | \name{chkHPD} 4 | \alias{chkHPD} 5 | \title{Verify the Integrity of a Hive Plot Data Object} 6 | \usage{ 7 | chkHPD(HPD, confirm = FALSE) 8 | } 9 | \arguments{ 10 | \item{HPD}{An object of S3 class \code{HivePlotData}.} 11 | 12 | \item{confirm}{Logical; if \code{TRUE} then a favorable result is affirmed 13 | in the console (problems are always reported).} 14 | } 15 | \value{ 16 | A logical value; \code{TRUE} is there is a problem, otherwise 17 | \code{FALSE}. 18 | } 19 | \description{ 20 | This function inspects the classes of each part of a \code{\link{HPD}} as a 21 | means of verifying its integrity. A few other characteristics are checked 22 | as well. 23 | } 24 | \examples{ 25 | 26 | test4 <- ranHiveData(nx = 4) 27 | good <- chkHPD(test4, confirm = TRUE) 28 | # mess it up and do again 29 | # next test is not run as it halts execution 30 | \dontrun{ 31 | test4$nodes$color <- as.factor(test4$nodes$color) 32 | bad <- chkHPD(test4) 33 | } 34 | 35 | } 36 | \seealso{ 37 | \code{\link{sumHPD}} which allows inspection (checking) of many 38 | properties of your \code{\link{HPD}}. 39 | } 40 | \author{ 41 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 42 | } 43 | \keyword{utilities} 44 | -------------------------------------------------------------------------------- /man/dot2HPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/dot2HPD.R 3 | \name{dot2HPD} 4 | \alias{dot2HPD} 5 | \title{Process a .dot Graph File into a Hive Plot Data Object} 6 | \usage{ 7 | dot2HPD( 8 | file = NULL, 9 | node.inst = NULL, 10 | edge.inst = NULL, 11 | axis.cols = NULL, 12 | type = "2D", 13 | desc = NULL, 14 | ... 15 | ) 16 | } 17 | \arguments{ 18 | \item{file}{The path to the .dot file to be processed.} 19 | 20 | \item{node.inst}{The path to a .csv file containing instructions about how 21 | to map node tags in the .dot file to parameters in the \code{HivePlotData} 22 | object. May be NULL.} 23 | 24 | \item{edge.inst}{The path to a .csv file containing instructions about how 25 | to map edge tags in the .dot file to parameters in the \code{HivePlotData} 26 | object. May be NULL.} 27 | 28 | \item{axis.cols}{A character vector giving the colors desired for the axes.} 29 | 30 | \item{type}{One of \code{c("2D", "3D")}. If \code{2D}, a 31 | \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 32 | be created and the eventual hive plot will be static and 2D. If \code{3D}, 33 | the \code{HivePlotData} object will be suitable for a 3D interactive plot 34 | using \code{\link{plot3dHive}}.} 35 | 36 | \item{desc}{Character. A description of the data set.} 37 | 38 | \item{\dots}{Other parameters to be passed downstream.} 39 | } 40 | \value{ 41 | A \code{\link{HivePlotData}} object. 42 | } 43 | \description{ 44 | This function will read a .dot file containing a graph specification in the 45 | DOT language, and (optionally) using two other files, convert the 46 | information into a \code{\link{HivePlotData}} object. 47 | } 48 | \details{ 49 | This function is currently agnostic with respect to whether or not the .dot 50 | graph is directed or not. Either type will be processed, but if the graph 51 | is directed, this will only be indirectly stored in the \code{HivePlotData} 52 | object (in that the first node of an edge in the .dot file will be in 53 | \code{HPD$nodes$id1} and the second node of an edge will be in 54 | \code{HPD$nodes$id2}. This fact can be used; see the vignette and 55 | \code{\link{mineHPD}}. Keep in mind the .dot standard is fairly loose. 56 | This function has been tested to work with several .dot files, include those 57 | with multiple tag=value attributes (in such cases, a typical line in the dot 58 | file should be formatted like this: node_name [tag1 = value1, tag2 = 59 | value2];). If you have trouble, please file a issue at Github so I can 60 | track it down. 61 | } 62 | \seealso{ 63 | See the vignette for an example of using this function. Use 64 | \code{browseVignettes("HiveR")} to produce the vignette. \cr \cr 65 | \code{\link{adj2HPD}} for a means of importing adjacency matrices. 66 | } 67 | \author{ 68 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 69 | } 70 | \keyword{utilities} 71 | -------------------------------------------------------------------------------- /man/drawHiveSpline.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/drawHiveSpline.R 3 | \name{drawHiveSpline} 4 | \alias{drawHiveSpline} 5 | \title{Draw a 3D Spline as Part of a 3D Hive Plot} 6 | \usage{ 7 | drawHiveSpline(HPD, L_A = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{HPD}{An object of S3 class \code{HivePlotData}.} 11 | 12 | \item{L_A}{Logical: should splines be drawn with \code{line_antialias = 13 | TRUE}?} 14 | 15 | \item{\dots}{Parameters to be passed downstream.} 16 | } 17 | \value{ 18 | None. A spline is added to the 3D hive plot in progress. 19 | } 20 | \description{ 21 | This function analyzes the edges of a \code{HivePlotData} object in order to 22 | draw 3D splines representing those edges. Each pair of nodes at the ends of 23 | an edge is identified, and a control point is computed. This information is 24 | passed to \code{\link{rcsr}} to work out the details. 25 | } 26 | \seealso{ 27 | \code{\link{plot3dHive}} which calls this function and is the user 28 | interface. 29 | } 30 | \author{ 31 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 32 | } 33 | \keyword{hplot} 34 | \keyword{plot} 35 | -------------------------------------------------------------------------------- /man/edge2HPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/edge2HPD.R 3 | \name{edge2HPD} 4 | \alias{edge2HPD} 5 | \title{Process an Edge List into a Hive Plot Data Object} 6 | \usage{ 7 | edge2HPD(edge_df = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{edge_df}{A data frame containing edge list information. Columns should 11 | be node1, node2, edge weight (column names are arbitrary). Edge weight 12 | information is optional. If missing, edge weights will be set to 1.} 13 | 14 | \item{axis.cols}{A character vector giving the colors desired for the axes.} 15 | 16 | \item{type}{One of \code{c("2D", "3D")}. If \code{2D}, a 17 | \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will 18 | be created and the eventual hive plot will be static and 2D. If \code{3D}, 19 | the \code{HivePlotData} object will be suitable for a 3D interactive plot 20 | using \code{\link{plot3dHive}}.} 21 | 22 | \item{desc}{Character. A description of the data set.} 23 | 24 | \item{\dots}{Other parameters to be passed downstream.} 25 | } 26 | \value{ 27 | A \code{\link{HivePlotData}} object. 28 | } 29 | \description{ 30 | This function will take an edge list and convert it into a basic 31 | \code{\link{HivePlotData}} object. Further manipulation by 32 | \code{\link{mineHPD}} will almost certainly be required before the data can 33 | be plotted. 34 | } 35 | \details{ 36 | This function produces a "bare bones" \code{HivePlotData} object. The user 37 | will likely have to make some changes manually to the resulting 38 | \code{HivePlotData} object before plotting. Alternatively, 39 | \code{\link{mineHPD}} may be able to extract some information buried in the 40 | data, but even then, the user might need to make some adjustments. See the 41 | examples. 42 | } 43 | \examples{ 44 | 45 | # Create a simple edge list & process it 46 | edges <- data.frame( 47 | lab1 = LETTERS[c(1:8, 7)], 48 | lab2 = LETTERS[c(2:4, 1:3, 4, 2, 2)], 49 | weight = c(1, 1, 2, 2, 3, 1, 2, 3, 1) 50 | ) 51 | 52 | td <- edge2HPD(edge_df = edges, desc = "Test of edge2HPD") 53 | td.out <- sumHPD(td, plot.list = TRUE) 54 | # compare: 55 | edges 56 | td.out[, c(3, 7, 8)] 57 | } 58 | \seealso{ 59 | \code{\link{dot2HPD}} and \code{\link{adj2HPD}} 60 | } 61 | \author{ 62 | Jonathan H. Chung, with minor changes for consistency by Bryan A. 63 | Hanson. 64 | } 65 | \keyword{utilities} 66 | -------------------------------------------------------------------------------- /man/manipAxis.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/manipAxis.R 3 | \name{manipAxis} 4 | \alias{manipAxis} 5 | \title{Modify the Display of Axes and Nodes in a Hive Plot} 6 | \usage{ 7 | manipAxis(HPD, method, action = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{HPD}{An object of S3 class \code{HivePlotData}.} 11 | 12 | \item{method}{One of \code{c("rank", "norm", "scale", "invert", "ranknorm", 13 | "prune", "offset", "stretch")} giving the type of modification to be made.} 14 | 15 | \item{action}{For \code{method = c("scale", "invert", "offset", "stretch")}, 16 | a numeric vector of the same length as the number of axes.} 17 | 18 | \item{...}{Arguments to be passed downstream. Needed in this case for when 19 | \code{plotHive} has arguments for \code{grid} that get laundered through 20 | \code{manipAxis}} 21 | } 22 | \value{ 23 | A modified \code{HivePlotData} object. 24 | } 25 | \description{ 26 | This function modifies various aspects of a \code{HivePlotData} object. A 27 | typical use is to convert the radii from the native/absolute values in the 28 | original object to either a normalized value (0\ldots{}1) or to a ranked 29 | value. The order of nodes on an axis can also be inverted, and an axis can 30 | be pruned (removed) from the \code{HivePlotData} object. 31 | } 32 | \details{ 33 | The rank method uses \code{ties.method = "first"} so that each node gets a 34 | unique radius. For pruning, the nodes and edges are removed and then the 35 | remaining axes are renumbered to start from one. Exercise caution! 36 | 37 | For \code{"scale"} node radii will be multiplied by the corresponding value 38 | in this argument. For \code{"invert"} a value of -1 will cause the 39 | corresponding axis to be inverted. For \code{"prune"}, a single value 40 | specifying the axis to be pruned should be given. For \code{"offset"} the 41 | values in \code{"action"} will be subtracted from the node radii. For 42 | \code{"stretch"}, node radii will first be offset so that the minimum value 43 | is zero, then multiplied by the values in \code{"action"} to stretch the 44 | axis. Depending upon the desired effect, one might use \code{"stretch"} 45 | followed by \code{"offset"} or perhaps other combinations. 46 | } 47 | \examples{ 48 | 49 | data(HEC) 50 | # The first 3 examples take advantage of the argument '...' 51 | # in plotHive, which passes action through to manipAxis on the fly. 52 | # For this particular data, norm and absolute scaling appear the same. 53 | 54 | plotHive(HEC, bkgnd = "white") # default is absolute positioning of nodes 55 | plotHive(HEC, method = "rank", bkgnd = "white") 56 | plotHive(HEC, method = "norm", bkgnd = "white") 57 | 58 | # In these examples, we'll explicitly use manipAxis and then plot 59 | # in a separate step. This is because trying to plot on the fly in 60 | # these cases will result in absolute scaling (which we do use here, 61 | # but one might not want to be forced to do so). 62 | 63 | HEC2 <- manipAxis(HEC, method = "invert", action = c(-1, 1)) 64 | plotHive(HEC2, bkgnd = "white") 65 | HEC3 <- manipAxis(HEC, method = "stretch", action = c(2, 3)) 66 | plotHive(HEC3, bkgnd = "white") 67 | HEC4 <- manipAxis(HEC, method = "offset", action = c(0, 1.5)) 68 | plotHive(HEC4, bkgnd = "white") 69 | } 70 | \author{ 71 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 72 | } 73 | \keyword{utilities} 74 | -------------------------------------------------------------------------------- /man/mineHPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/mineHPD.R 3 | \name{mineHPD} 4 | \alias{mineHPD} 5 | \title{Examine (mine) a Hive Plot Data Object and Extract Information Contained 6 | Within It} 7 | \usage{ 8 | mineHPD(HPD, option = "rad <- tot.edge.count") 9 | } 10 | \arguments{ 11 | \item{HPD}{A \code{\link{HivePlotData}} object.} 12 | 13 | \item{option}{A character string giving the option desired. See Details for 14 | current options.} 15 | } 16 | \value{ 17 | A modified \code{HivePlotData} object. 18 | } 19 | \description{ 20 | A \code{HivePlotData object}, especially one created fresh using 21 | \code{\link{dot2HPD}}, generally contains a lot of hidden information about 22 | the network described. This function can extract this hidden information. 23 | This function has \code{option}s which are quite specific as to what they 24 | do. The user can easily write new options and incorporate them. 25 | This function can be called multiple times 26 | using different options to gradually modify the \code{HivePlotData} object. 27 | } 28 | \details{ 29 | \code{option = "rad <- tot.edge.count"} This option looks through the 30 | \code{HivePlotData} object and determines how many edges start or end on 31 | each node (the "degree"). This value is then assigned to the radius for 32 | that node. 33 | 34 | \code{option = "axis <- source.man.sink"} This option 35 | examines the nodes and corresponding edges in a \code{HivePlotData} object 36 | to determine if the node is a source, manager or sink. A source node only 37 | has outgoing edges. A sink node only has incoming edges. A manager has 38 | both. Hence, this option treats the \code{HivePlotData} object as if it 39 | were directed in that the first node of an edge in will be in 40 | \code{HPD$nodes$id1} and the second node of an edge will be in 41 | \code{HPD$nodes$id2}. As a result, this option produces a hive plot with 3 42 | axes (note: sources are on axis 1, sinks on axis 2, and managers on axis 3). 43 | This concept is similar to the idea of \code{\link[FuncMap]{FuncMap}} but 44 | the internals are quite different. See also \code{\link{dot2HPD}} for some 45 | details about processing .dot files in an agnostic fashion. 46 | 47 | \code{option = "remove orphans"} removes nodes that have degree zero (no 48 | incoming or outgoing edges). 49 | 50 | \code{option = "remove zero edge"} 51 | removes edges with length zero. Such edges cause an error because 52 | the spline cannot be drawn. This option combines the next two options. 53 | 54 | \code{option = "remove self edge"} removes edges that 55 | start and end on the same node. 56 | 57 | \code{option = "remove virtual edge"} removes virtual edges which are 58 | edges which involve different nodes but the nodes happen to be on the 59 | the same axis at the same radius. 60 | 61 | \code{option = "remove edges same axis"} removes edges which start and 62 | end on the same axis. 63 | } 64 | \seealso{ 65 | See the vignette for an example of using this function. Use 66 | \code{browseVignettes("HiveR")} to produce the vignette. 67 | } 68 | \author{ 69 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 70 | } 71 | \keyword{utilities} 72 | -------------------------------------------------------------------------------- /man/plotHive.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot3dHive.R, R/plotHive.R 3 | \name{plot3dHive} 4 | \alias{plot3dHive} 5 | \alias{plotHive} 6 | \title{Create (Plot) a 2D or 3D Hive Plot} 7 | \usage{ 8 | plot3dHive( 9 | HPD, 10 | ch = 1, 11 | dr.nodes = TRUE, 12 | method = "abs", 13 | axLabs = NULL, 14 | axLab.pos = NULL, 15 | LA = FALSE, 16 | ... 17 | ) 18 | 19 | plotHive( 20 | HPD, 21 | ch = 1, 22 | method = "abs", 23 | dr.nodes = TRUE, 24 | bkgnd = "black", 25 | axLabs = NULL, 26 | axLab.pos = NULL, 27 | axLab.gpar = NULL, 28 | anNodes = NULL, 29 | anNode.gpar = NULL, 30 | grInfo = NULL, 31 | arrow = NULL, 32 | np = TRUE, 33 | anCoord = "local", 34 | ... 35 | ) 36 | } 37 | \arguments{ 38 | \item{HPD}{An object of S3 class \code{\link{HivePlotData}}.} 39 | 40 | \item{ch}{Numeric; the size of the central hole in the hive plot.} 41 | 42 | \item{dr.nodes}{Logical; if \code{TRUE} nodes will be drawn.} 43 | 44 | \item{method}{Character. Passed to \code{\link{manipAxis}} (see there for 45 | allowed values - the default given above plots using the native or absolute 46 | coordinates of the data).} 47 | 48 | \item{axLabs}{A vector of character strings for the axis labels.} 49 | 50 | \item{axLab.pos}{Numeric; An offset from the end of the axis for label 51 | placement. Either a single value or a vector of values. If a single value, 52 | all labels are offset the same amount. If a vector of values, there should 53 | be a value for each axis. This allows flexibility with long axis names. 54 | The units depend upon the \code{method} employed (see Details).} 55 | 56 | \item{LA}{(Applies to \code{plot3dHive} only) Logical: should splines be 57 | drawn with \code{line_antialias = TRUE}? See Details.} 58 | 59 | \item{\dots}{Additional parameters to be passed downstream.} 60 | 61 | \item{bkgnd}{Any valid color specification. Used for the background color 62 | for \code{plotHive}.} 63 | 64 | \item{axLab.gpar}{(Applies to \code{plotHive} only) A list of name - value 65 | pairs acceptable to \code{\link{gpar}}. These control the label and arrow 66 | displays. See the examples.} 67 | 68 | \item{anNodes}{(Applies to \code{plotHive} only) The path to a csv file 69 | containing information for labeling nodes. If present, a line segment will 70 | be drawn from the node to the specified text. The text is positioned near 71 | the end of the line segment. The columns in the csv file must be named as 72 | follows (description and use in parentheses): node.lab (node label from 73 | HPD$nodes$lab), node.text (the text to be drawn on the plot), angle (polar 74 | coordinates: angle at which to draw the segment), radius (polar coordinates: 75 | radius at which to draw the text), offset (additional distance along the 76 | radius vector to offset text), hjust, vjust (horizontal and vertical 77 | justification; nominally in [0\ldots{}1] but fractional and negative values 78 | also work). The first two values will be treated as type \code{character}, 79 | the others as \code{numeric}.} 80 | 81 | \item{anNode.gpar}{(Applies to \code{plotHive} only) A list of name - value 82 | pairs acceptable to \code{\link{gpar}}. These control both the text used to 83 | annotate the nodes and the line segments connecting that text to the node. 84 | See the examples.} 85 | 86 | \item{grInfo}{(Applies to \code{plotHive} only) The path to a csv file 87 | containing information for adding graphic decorations to the plot. If 88 | present, a line segment will be drawn from the node to the specified 89 | location and the graphic is positioned near the end the line segment. The 90 | columns in the csv file must be named as follows (description and use in 91 | parentheses): node.lab (node label from HPD$nodes$lab), angle (polar 92 | coordinates: angle at which to position the graphic), radius (polar 93 | coordinates: radius at which to position the graphic), offset (additional 94 | distance along radius vector to offset the graphic), width (the width of the 95 | graphic), path (a valid path to the graphics in jpg or png format). The 96 | path should include the extension is it is autodetected. Valid extensions 97 | are jpg, JPG, jpeg, JPEG, png, or PNG. All image files must be of the same 98 | type (all jpg, or all png).} 99 | 100 | \item{arrow}{(Applies to \code{plotHive} only) A vector of 5 or 6 values: a 101 | character string to label the arrow, and 4 numeric values giving the angle 102 | of the arrow, the radius at which to start the arrow, the radius at which to 103 | end the arrow, and a value to offset the arrow label from the end of the 104 | arrow. A 5th numeric value (the 6th argument overall) can specify an offset 105 | in the y direction for the arrow useful when \code{nx = 2}. See the 106 | examples.} 107 | 108 | \item{np}{(Applies to \code{plotHive} only) Logical; should a new device 109 | (page) be opened when drawing the hive plot? If you are making multiple 110 | plots within some sort of \code{grid} scheme then this should be set to 111 | \code{FALSE}.} 112 | 113 | \item{anCoord}{(Applies to \code{plotHive} only) One of \code{c("local", 114 | "global")}. Controls how the position of node labels and graphic 115 | decorations are specified. See Details.} 116 | } 117 | \value{ 118 | None. Side effect is a plot. 119 | } 120 | \description{ 121 | These functions plot a \code{HivePlotData} object in either 2D or 3D, 122 | depending upon which function is called. 123 | } 124 | \details{ 125 | \strong{General}. \code{plotHive} uses \code{grid} graphics to produce a 2D hive 126 | plot in a style similar to the original concept. For a 2D plot, axis number 127 | 1 is vertical except in the case of 2 axes in which case it is to the right. 128 | \code{plot3dHive} produces a 3D hive plot using \code{rgl} graphics. 129 | Functions from either package can be used to make additional modifications 130 | after the hive plot is drawn, either via the \ldots{} argument or by 131 | subsequent function calls. See the examples. 132 | 133 | \strong{Units and Annotations}. If you add node labels, arrows or graphic decorations, 134 | the units that you 135 | must specify are those intrinsic to the data itself, modified by your 136 | setting of \code{ch} and \code{method}. These generally cannot be known 137 | precisely ahead of time, so some experimentation will be necessary to polish 138 | the plots. For instance, if you have data with node radii that run from 139 | 4-23 then you have an idea of how to position your annotations if using 140 | \code{method = "abs"}. But the same data plotted with \code{method = 141 | "norm"} or \code{method = "rank"} will require that you move your annotation 142 | positions accordingly. In the first case no radius is larger than 23, but 143 | the maximum radius is 1 when the data is normed and when it is ranked, the 144 | maximum value will depend upon which axis has the most nodes on it, and the 145 | number of unique radii values. 146 | 147 | \strong{Positioning Node Labels and Graphics}. 148 | In addition to the nuances just above, there are two ways to specify the 149 | location of node labels and graphic decorations. Polar coordinates are used 150 | in both cases. If \code{annCoord = "local"} then the angle, radius and 151 | offset arguments are relative to the node to be annotated. An angle of 0 152 | positions the label horizontally to the right of the node. Thus the label 153 | can be placed within a circular area around the node. If \code{annCoord = 154 | "global"} then the specifications are relative to dead center on the plot. 155 | These two methods give one lots of flexibility in lining up labels in 156 | different ways. See the examples. 157 | 158 | \strong{Size of Graphics}. The size of 159 | graphic decorations is controlled by the column 'width' in \code{grInfo}. 160 | The ultimate call to display the graphic is done with \code{as.raster}. 161 | Specifying only the width preserves the aspect ratio of the graphic. See 162 | \code{?as.raster} for further discussion. 163 | 164 | \strong{Colors}. For any of the 165 | \code{gpar} arguments, watch out: In grid graphics the default color for 166 | text and arrows is black, so if are using the default \code{bkgnd = "black"} 167 | in the hive plot be sure to specify \code{col = "white"} (or some other 168 | non-black color) for the labels and arrows or you won't see them. 169 | 170 | \strong{Speed and 3D Hive Plots}. For most work with \code{plot3dHive}, use \code{LA 171 | = FALSE} for speed of drawing. \code{LA = TRUE} is over 20 times slower, 172 | and is more appropriate for high quality hive plots. These are probably 173 | better made with \code{R CMD BATCH script.R} rather than interactive use. 174 | } 175 | \section{Functions}{ 176 | \itemize{ 177 | \item \code{plot3dHive()}: Create a 3D Hive Plot 178 | 179 | \item \code{plotHive()}: Create a 2D Hive Plot 180 | 181 | }} 182 | \examples{ 183 | 184 | ### 2D Hive Plots 185 | require("grid") 186 | # Generate some random data 187 | test2 <- ranHiveData(nx = 2) 188 | test3 <- ranHiveData(nx = 3) 189 | 190 | # First the nx = 2 case. 191 | # Note that gpar contains parameters that apply to both the 192 | # axis labels and arrow. A 6th value in arrow offsets the arrow vertically: 193 | plotHive(test2, 194 | ch = 5, axLabs = c("axis 1", "axis 2"), rot = c(-90, 90), 195 | axLab.pos = c(20, 20), axLab.gpar = gpar(col = "pink", fontsize = 14, lwd = 2), 196 | arrow = c("radius units", 0, 20, 60, 25, 40) 197 | ) 198 | 199 | # Now nx = 3: 200 | plotHive(test3) # default plot 201 | 202 | # Add axis labels & options to nx = 3 example. Note that rot is not part of gpar 203 | plotHive(test3, 204 | ch = 5, axLabs = c("axis 1", "axis 2", "axis 3"), 205 | axLab.pos = c(10, 15, 15), rot = c(0, 30, -30), 206 | axLab.gpar = gpar(col = "orange", fontsize = 14) 207 | ) 208 | 209 | # Call up a built-in data set to illustrate some plotting tricks 210 | data(HEC) 211 | require("grid") # for text additions outside of HiveR (grid.text) 212 | 213 | plotHive(HEC, 214 | ch = 0.1, bkgnd = "white", 215 | axLabs = c("hair\ncolor", "eye\ncolor"), 216 | axLab.pos = c(1, 1), 217 | axLab.gpar = gpar(fontsize = 14) 218 | ) 219 | grid.text("males", x = 0, y = 2.3, default.units = "native") 220 | grid.text("females", x = 0, y = -2.3, default.units = "native") 221 | grid.text("Pairing of Eye Color with Hair Color", 222 | x = 0, y = 4, 223 | default.units = "native", gp = gpar(fontsize = 18) 224 | ) 225 | 226 | # Add node labels and graphic decorations 227 | # The working directory has to include 228 | # not only the grInfo and anNodes files but also the jpgs. 229 | # So, we are going to move to such a directory and return you home afterwards. 230 | 231 | currDir <- getwd() 232 | setwd(system.file("extdata", "Misc", package = "HiveR")) 233 | plotHive(HEC, 234 | ch = 0.1, bkgnd = "white", 235 | axLabs = c("hair\ncolor", "eye\ncolor"), 236 | axLab.pos = c(1, 1), 237 | axLab.gpar = gpar(fontsize = 14), 238 | anNodes = "HECnodes.txt", 239 | anNode.gpar = gpar(col = "black"), 240 | grInfo = "HECgraphics.txt", 241 | arrow = c("more\ncommon", 0.0, 2, 4, 1, -2) 242 | ) 243 | 244 | grid.text("males", x = 0, y = 2.3, default.units = "native") 245 | grid.text("females", x = 0, y = -2.3, default.units = "native") 246 | grid.text("Pairing of Eye Color with Hair Color", 247 | x = 0, y = 3.75, 248 | default.units = "native", gp = gpar(fontsize = 18) 249 | ) 250 | grid.text("A test of plotHive annotation options", 251 | x = 0, y = 3.25, 252 | default.units = "native", gp = gpar(fontsize = 12) 253 | ) 254 | grid.text("Images from Wikipedia Commons", 255 | x = 0, y = -3.5, 256 | default.units = "native", gp = gpar(fontsize = 9) 257 | ) 258 | setwd(currDir) 259 | 260 | # Use the node label concept to create tick marks 261 | 262 | currDir <- getwd() 263 | setwd(system.file("extdata", "Misc", package = "HiveR")) 264 | plotHive(HEC, 265 | ch = 0.1, bkgnd = "white", 266 | axLabs = c("hair\ncolor", "eye\ncolor"), 267 | axLab.pos = c(1, 1), 268 | axLab.gpar = gpar(fontsize = 14), 269 | anNodes = "HECticks.txt", 270 | anNode.gpar = gpar(col = "black"), 271 | arrow = c("more\ncommon", 0.0, 2, 4, 1, -2), 272 | dr.nodes = FALSE 273 | ) 274 | 275 | grid.text("males", x = 0, y = 2.3, default.units = "native") 276 | grid.text("females", x = 0, y = -2.3, default.units = "native") 277 | grid.text("Pairing of Eye Color with Hair Color", 278 | x = 0, y = 3.75, 279 | default.units = "native", gp = gpar(fontsize = 18) 280 | ) 281 | grid.text("Adding tick marks to the nodes", 282 | x = 0, y = 3.25, 283 | default.units = "native", gp = gpar(fontsize = 12) 284 | ) 285 | setwd(currDir) 286 | 287 | 288 | ### 3D Hive Plots. The following must be run interactively. 289 | \dontrun{ 290 | require("rgl") 291 | test4 <- ranHiveData(nx = 4, type = "3D") 292 | plot3dHive(test4) 293 | } 294 | 295 | } 296 | \author{ 297 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 298 | } 299 | \keyword{interactive} 300 | \keyword{plot} 301 | -------------------------------------------------------------------------------- /man/ranHiveData.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ranHiveData.R 3 | \name{ranHiveData} 4 | \alias{ranHiveData} 5 | \title{Generate Random Hive Plot Data} 6 | \usage{ 7 | ranHiveData( 8 | type = "2D", 9 | nx = 4, 10 | nn = nx * 15, 11 | ne = nx * 15, 12 | rad = 1:100, 13 | ns = c(0.5, 1, 1.5), 14 | ew = 1:3, 15 | nc = brewer.pal(5, "Set1"), 16 | ec = brewer.pal(5, "Set1"), 17 | axis.cols = brewer.pal(nx, "Set1"), 18 | desc = NULL, 19 | allow.same = FALSE, 20 | verbose = FALSE 21 | ) 22 | } 23 | \arguments{ 24 | \item{type}{The type of hive plot to be generated. One of \code{c("2D", 25 | "3D")}.} 26 | 27 | \item{nx}{An integer giving the number of axes to be created (\code{2 =< nx 28 | =< 6}).} 29 | 30 | \item{nn}{An integer giving the number of nodes to be created. This is an 31 | initial number which may be reduced during clean up. See Details.} 32 | 33 | \item{ne}{An integer giving the number of edges to be created. This is an 34 | initial number which may be reduced during clean up. See Details.} 35 | 36 | \item{rad}{Numeric; a range of values that will be used as node radius 37 | values (the position of the node along the axis).} 38 | 39 | \item{ns}{Numeric; a range of values that will be used as the node sizes.} 40 | 41 | \item{ew}{Numeric; a range of values that will be used as the edge weights.} 42 | 43 | \item{nc}{A vector of valid color names giving the node colors.} 44 | 45 | \item{ec}{A vector of valid color names giving the edge colors.} 46 | 47 | \item{axis.cols}{A vector of valid color names to be used to color the axes; 48 | \code{length(axis.cols) must = nx}.} 49 | 50 | \item{desc}{Character; a description of the data set.} 51 | 52 | \item{allow.same}{Logical; indicates if edges may begin and end on the same 53 | axis. Only applies to \code{type = 2D}.} 54 | 55 | \item{verbose}{Logical; If \code{TRUE}, the generation, processing and final 56 | result is reported to the console.} 57 | } 58 | \value{ 59 | An object of S3 class \code{\link{HivePlotData}}. 60 | } 61 | \description{ 62 | This function generates random data sets which can be used to make a hive 63 | plot. 64 | } 65 | \details{ 66 | For \code{type = "2D"}, after the function creates an initial set of random 67 | nodes, these are randomly chosen and connected between adjacent axes, so 68 | that no edge crosses an axis. \cr \cr For \code{type = "3D"}, after the 69 | function creates an initial set of random nodes and edges, these are cleaned 70 | up by removing the following cases (which the rest of \code{HiveR} is not 71 | intended to handle at this time): duplicated nodes, nodes that are not part 72 | of any edge, edges that begin and end on the same point, edges that begin 73 | and end on the same axis, and finally, for \code{nx = 5 or 6}, edges that 74 | begin and end on colinear axes. Most of these don't cause an error, but 75 | produce some ugly results. \cr \cr For the arguments \code{rad, ns, ew, nc} 76 | and \code{ec}, the values given are sampled randomly (with replacement) and 77 | assigned to particular nodes or edges. 78 | } 79 | \section{Warning}{ 80 | If you create a very small data set with few nodes, there 81 | may be no nodes assigned to some axes which will give an error when you try 82 | to plot the data. It's up to the user to check for this possibility (you 83 | can use \code{sumHPD}). 84 | } 85 | 86 | \examples{ 87 | 88 | test4 <- ranHiveData(nx = 4) 89 | str(test4) 90 | sumHPD(test4) 91 | } 92 | \author{ 93 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 94 | } 95 | \keyword{datagen} 96 | -------------------------------------------------------------------------------- /man/rcsr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rcsr.R 3 | \name{rcsr} 4 | \alias{rcsr} 5 | \title{Compute the Details of a 3D Spline for a Hive Plot Edge} 6 | \usage{ 7 | rcsr(p0, cp, p1) 8 | } 9 | \arguments{ 10 | \item{p0}{A triple representing one end of the final curve (x, y, z).} 11 | 12 | \item{cp}{A triple representing the control point used to compute the final 13 | curve (x, y, z).} 14 | 15 | \item{p1}{A triple representing the other end of the final curve (x, y, z).} 16 | } 17 | \value{ 18 | A 3 column matrix with the x, y and z coordinates to be plotted to 19 | create a hive plot edge. 20 | } 21 | \description{ 22 | This is a wild bit of trigonometry! Three points in 3D space, two ends and 23 | an control point, are rotated into 2D space. Then a spline curve is 24 | computed. This is necessary because spline curves are only defined in 25 | \code{R} as 2D objects. The new collection of points, which is the complete 26 | spline curve and when drawn will be the edge of a hive plot, is rotated back 27 | into the original 3D space. \code{rcsr} stands for rotate, compute spline, 28 | rotate back. 29 | } 30 | \details{ 31 | See the code for exactly how the function works. Based upon the process 32 | described at \url{http://www.fundza.com/mel/axis_to_vector/index.html} 33 | Timing tests show this function is fast and scales linearly (i.e. 10x more 34 | splines to draw takes 10x more time). Roughly 3 seconds were required to 35 | draw 1,000 spline curves in my testing. 36 | } 37 | \examples{ 38 | 39 | # This is a lengthy example to prove it works. 40 | # Read it and then copy the whole thing to a blank script. 41 | # Parts of it require rgl and are interactive. 42 | # So none of the below is run during package build/check. 43 | 44 | ### First, a helper function 45 | \dontrun{ 46 | 47 | drawUnitCoord <- function() { 48 | 49 | # Simple function to draw a unit 3D coordinate system 50 | 51 | # Draw a Coordinate System 52 | 53 | r <- c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1) # in polar coordinates 54 | theta <- c(0, 0, 0, 90, 0, 180, 0, 270, 0, 0, 0, 0) # start, end, start, end 55 | phi <- c(0, 90, 0, 90, 0, 90, 0, 90, 0, 0, 0, 180) 56 | cs <- data.frame(radius = r, theta, phi) 57 | ax.coord <- sph2cart(cs) 58 | 59 | segments3d(ax.coord, col = "gray", line_antialias = TRUE) 60 | points3d( 61 | x = 0, y = 0, z = 0, color = "black", size = 4, 62 | point_antialias = TRUE 63 | ) # plot origin 64 | 65 | # Label the axes 66 | 67 | r <- c(1.1, 1.1, 1.1, 1.1, 1.1, 1.1) # in polar coordinates 68 | theta <- c(0, 90, 180, 270, 0, 0) 69 | phi <- c(90, 90, 90, 90, 0, 180) 70 | l <- data.frame(radius = r, theta, phi) 71 | lab.coord <- sph2cart(l) 72 | text3d(lab.coord, texts = c("+x", "+y", "-x", "-y", "+z", "-z")) 73 | } 74 | 75 | ### Now, draw a reference coordinate system and demo the function in it. 76 | 77 | drawUnitCoord() 78 | 79 | ### Draw a bounding box 80 | 81 | box <- data.frame( 82 | x = c(1, -1, 1, 1, 1, 1, 1, 1, 1, -1, -1, -1, 1, 1, 1, -1, 1, -1, -1, -1, -1, -1, -1, -1), 83 | y = c(1, 1, 1, 1, 1, -1, 1, -1, 1, 1, 1, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, 1), 84 | z = c(1, 1, 1, -1, 1, 1, -1, -1, -1, -1, 1, -1, 1, -1, 1, 1, -1, -1, -1, 1, 1, 1, -1, -1) 85 | ) 86 | 87 | segments3d(box$x, box$y, box$z, line_antialias = TRUE, col = "red") 88 | 89 | ### Draw the midlines defining planes 90 | 91 | mid <- data.frame( 92 | x = c(0, 0, 0, 0, 0, 0, 0, 0, 1, -1, -1, -1, -1, 1, 1, 1, 1, -1, -1, -1, -1, 1, 1, 1), 93 | y = c(-1, -1, -1, 1, 1, 1, 1, -1, 0, 0, 0, 0, 0, 0, 0, 0, -1, -1, -1, 1, 1, 1, 1, -1), 94 | z = c(-1, 1, 1, 1, 1, -1, -1, -1, -1, -1, -1, 1, 1, 1, 1, -1, 0, 0, 0, 0, 0, 0, 0, 0) 95 | ) 96 | 97 | segments3d(mid$x, mid$y, mid$z, line_antialias = TRUE, col = "blue") 98 | 99 | ### Generate two random points 100 | 101 | p <- runif(6, -1, 1) 102 | 103 | # Special case where p1 is on z axis 104 | # Uncomment line below to demo 105 | # p[4:5] <- 0 106 | 107 | p0 <- c(p[1], p[2], p[3]) 108 | p1 <- c(p[4], p[5], p[6]) 109 | 110 | ### Draw the pts, label them, draw vectors to those pts from origin 111 | 112 | segments3d( 113 | x = c(0, p[1], 0, p[4]), 114 | y = c(0, p[2], 0, p[5]), 115 | z = c(0, p[3], 0, p[6]), 116 | line_antialias = TRUE, col = "black", lwd = 3 117 | ) 118 | 119 | points3d( 120 | x = c(p[1], p[4]), 121 | y = c(p[2], p[5]), 122 | z = c(p[3], p[6]), 123 | point_antialias = TRUE, col = "black", size = 8 124 | ) 125 | 126 | text3d( 127 | x = c(p[1], p[4]), 128 | y = c(p[2], p[5]), 129 | z = c(p[3], p[6]), 130 | col = "black", texts = c("p0", "p1"), adj = c(1, 1) 131 | ) 132 | 133 | ### Locate control point 134 | ### Compute and draw net vector from origin thru cp 135 | ### Connect p0 and p1 136 | 137 | s <- p0 + p1 138 | segments3d( 139 | x = c(0, s[1]), y = c(0, s[2]), z = c(0, s[3]), 140 | line_antialias = TRUE, col = "grey", lwd = 3 141 | ) 142 | 143 | segments3d( 144 | x = c(p[1], p[4]), # connect p0 & p1 145 | y = c(p[2], p[5]), 146 | z = c(p[3], p[6]), 147 | line_antialias = TRUE, col = "grey", lwd = 3 148 | ) 149 | 150 | cp <- 0.6 * s # Now for the control point 151 | 152 | points3d( 153 | x = cp[1], # Plot the control point 154 | y = cp[2], 155 | z = cp[3], 156 | point_antialias = TRUE, col = "black", size = 8 157 | ) 158 | 159 | text3d( 160 | x = cp[1], # Label the control point 161 | y = cp[2], 162 | z = cp[3], 163 | texts = c("cp"), col = "black", adj = c(1, 1) 164 | ) 165 | 166 | ### Now ready to work on the spline curve 167 | 168 | n2 <- rcsr(p0, cp, p1) # Compute the spline 169 | 170 | lines3d( 171 | x = n2[, 1], y = n2[, 2], z = n2[, 3], 172 | line_antialias = TRUE, col = "blue", lwd = 3 173 | ) 174 | 175 | ### Ta-Da!!!!! 176 | } 177 | 178 | } 179 | \author{ 180 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 181 | } 182 | \keyword{3D} 183 | \keyword{spline} 184 | \keyword{utilities} 185 | -------------------------------------------------------------------------------- /man/sph2cart.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sph2cart.R 3 | \name{sph2cart} 4 | \alias{sph2cart} 5 | \title{Convert Spherical to Cartesian Coordinates} 6 | \usage{ 7 | sph2cart(df) 8 | } 9 | \arguments{ 10 | \item{df}{A data frame with columns named r, theta and phi with the radius 11 | and angles (in spherical coordinates) to be converted to Cartesian 12 | coordinates.} 13 | } 14 | \value{ 15 | A data frame with named columns containing the converted 16 | coordinates. 17 | } 18 | \description{ 19 | This function converts spherical to Cartesian coordinates. 20 | } 21 | \note{ 22 | Cobbled together from similar functions in other packages. 23 | } 24 | \author{ 25 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 26 | } 27 | \keyword{utilities} 28 | -------------------------------------------------------------------------------- /man/sumHPD.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sumHPD.R 3 | \name{sumHPD} 4 | \alias{sumHPD} 5 | \title{Summarize a Hive Plot Data Object and Optionally Run Some Checks} 6 | \usage{ 7 | sumHPD( 8 | HPD, 9 | chk.all = FALSE, 10 | chk.sm.pt = FALSE, 11 | chk.ax.jump = FALSE, 12 | chk.sm.ax = FALSE, 13 | chk.orphan.node = FALSE, 14 | chk.virtual.edge = FALSE, 15 | plot.list = FALSE, 16 | tex = FALSE, 17 | orphan.list = FALSE 18 | ) 19 | } 20 | \arguments{ 21 | \item{HPD}{An object of S3 class \code{HivePlotData}.} 22 | 23 | \item{chk.all}{Logical; should all the checks below be run? See Details.} 24 | 25 | \item{chk.sm.pt}{Logical; should the edges be checked to see if any of them 26 | start and end on the same axis with the same radius? See Details.} 27 | 28 | \item{chk.ax.jump}{Logical; should the edges be checked to see if any of 29 | them start and end on non-adjacent axes, e.g. axis 1 --> axis 3? See 30 | Details.} 31 | 32 | \item{chk.sm.ax}{Logical; should the edges be checked to see if any of them 33 | start and end on the same axis?} 34 | 35 | \item{chk.orphan.node}{Logical; should orphan nodes be identifed? Orphan 36 | nodes have degree 0 (no incoming or outgoing edges).} 37 | 38 | \item{chk.virtual.edge}{Logical; should the edges be checked to see if any of them 39 | start and end on different nodes which happen to be at the same radius on the 40 | same axis? See Details.} 41 | 42 | \item{plot.list}{Logical; should a data frame of edges to be drawn be 43 | returned?} 44 | 45 | \item{tex}{Logical; should the \code{plot.list} be formatted for LaTeX?} 46 | 47 | \item{orphan.list}{Logical; should a data frame of orphaned nodes be 48 | returned?} 49 | } 50 | \value{ 51 | A summary of the \code{HivePlotData} object's key characteristics is 52 | printed at the console, followed by the results of any checks set to 53 | \code{TRUE}. The format of these results is identical to that of 54 | \code{plot.list} described just below, except for the orphan node check. 55 | This is formatted the same as \code{HPD$nodes}; see \code{?HPD} for details. 56 | 57 | If \code{plot.list = TRUE}, a data frame containing a list of the 58 | edges to be drawn in a format suitable for troubleshooting a plot. If 59 | \code{tex = TRUE} as well, the data frame will be in a format suitable for 60 | pasting into a LaTeX document. The data frame will contain rows describing 61 | each edge to be drawn with the following columns: node 1 id, node 1 axis, 62 | node 1 label, node 1 radius, then the same info for node 2, then the edge 63 | weight and the edge color. 64 | 65 | If \code{orphan.list = TRUE} a data frame 66 | giving the orphan nodes is returned. If you want both \code{plot.list} and 67 | \code{orphan.list} you have to call this function twice. 68 | } 69 | \description{ 70 | This function summarizes a \code{\link{HivePlotData}} object in a convenient 71 | form. Optionally, it can run some checks for certain conditions that may be 72 | of interest. It can also output a summary of edges to be drawn, either as a 73 | data frame or in a LaTeX ready form, or a data frame of orphaned nodes. 74 | } 75 | \details{ 76 | Argument \code{chk.sm.pt} applies only to hive plots of \code{type = 2D}. 77 | It checks to see if any of the edges start and end at the same node id. 78 | These by definition exist at the same radius on the same axis, which 79 | causes an error in \code{plotHive} since you are trying to draw an edge of 80 | length zero (the actual error message is \code{Error in calcCurveGrob(x, 81 | x$debug) : End points must not be identical}. Some data sets may have such 82 | cases intrinsically or due to data entry error, or the condition may arise 83 | during processing. Either way, one needs to be able to detect such cases 84 | for removal or modification. This argument will tell you which nodes cause 85 | the problem. 86 | 87 | Argument \code{chk.virtual.edge} applies only to hive plots of \code{type = 2D} 88 | and is similiar to \code{chk.sm.pt} above except 89 | that it checks for virtual edges. These are edges start and end on the 90 | same axis at the same radius but at different node id's (in other words, 91 | two nodes have the same radius on the same axis). This condition 92 | gives the same error as above. It is checked for separately as it arises 93 | via a different problem in the construction of the data. 94 | 95 | Argument \code{chk.ax.jump} applies only to hive plots 96 | of \code{type = 2D}. It checks to see if any of the edges jump an axis, 97 | e.g. axis 1 --> axis 3. This argument will tell you which nodes are at 98 | either end of the jumping edge. Jumping should should be avoided in hive 99 | plots as it makes the plot aesthetically unpleasing. However, depending 100 | upon how you process the data, this condition may arise and hence it is 101 | useful to be able to locate jumps. 102 | } 103 | \examples{ 104 | 105 | set.seed(55) 106 | test <- ranHiveData(nx = 4, ne = 5, desc = "Tiny 4D data set") 107 | out <- sumHPD(test, chk.all = TRUE, plot.list = TRUE) 108 | print(out) 109 | } 110 | \author{ 111 | Bryan A. Hanson, DePauw University. \email{hanson@depauw.edu} 112 | } 113 | \keyword{utilities} 114 | --------------------------------------------------------------------------------