[med-svn] [r-cran-treespace] 01/02: New upstream version 1.0.0
Andreas Tille
tille at debian.org
Thu Sep 14 17:22:42 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-treespace.
commit 7547dcbd38d6fd1ca2ef7edd3dbdb505830445fe
Author: Andreas Tille <tille at debian.org>
Date: Thu Sep 14 19:19:20 2017 +0200
New upstream version 1.0.0
---
DESCRIPTION | 34 +
LICENSE | 2 +
MD5 | 108 +
NAMESPACE | 61 +
R/RcppExports.R | 7 +
R/data.R | 93 +
R/findGroves.R | 100 +
R/medTree.R | 218 ++
R/metrics.R | 506 +++
R/plotGroves.R | 251 ++
R/plotTreeDiff.R | 182 +
R/servers.R | 74 +
R/transmissionTrees.R | 218 ++
R/treespace.R | 150 +
README.md | 158 +
build/vignette.rds | Bin 0 -> 318 bytes
data/DengueBEASTMCC.RData | Bin 0 -> 682 bytes
data/DengueSeqs.RData | Bin 0 -> 1662 bytes
data/DengueTrees.RData | Bin 0 -> 129828 bytes
data/fluTrees.RData | Bin 0 -> 537692 bytes
data/woodmiceTrees.RData | Bin 0 -> 44056 bytes
inst/doc/DengueVignette.R | 227 ++
inst/doc/DengueVignette.Rmd | 338 ++
inst/doc/DengueVignette.html | 3566 ++++++++++++++++++++
inst/doc/TransmissionTreesVignette.R | 132 +
inst/doc/TransmissionTreesVignette.Rmd | 214 ++
inst/doc/TransmissionTreesVignette.html | 313 ++
inst/doc/introduction.R | 153 +
inst/doc/introduction.Rmd | 395 +++
inst/doc/introduction.html | 437 +++
inst/shiny/server.R | 1287 +++++++
inst/shiny/ui.R | 677 ++++
inst/shiny/www/bootstrap.simplex.css | 11 +
inst/shiny/www/html/help.html | 207 ++
inst/shiny/www/img/line.png | Bin 0 -> 21260 bytes
inst/shiny/www/img/logo.png | Bin 0 -> 56495 bytes
inst/shiny/www/styles.css | 11 +
man/DengueBEASTMCC.Rd | 26 +
man/DengueSeqs.Rd | 22 +
man/DengueTrees.Rd | 28 +
man/findGroves.Rd | 59 +
man/findMRCIs.Rd | 33 +
man/fluTrees.Rd | 25 +
man/linearMrca.Rd | 30 +
man/medTree.Rd | 86 +
man/multiDist.Rd | 53 +
man/plotGroves.Rd | 97 +
man/plotGrovesD3.Rd | 69 +
man/plotTreeDiff.Rd | 72 +
man/refTreeDist.Rd | 44 +
man/tipDiff.Rd | 42 +
man/treeDist.Rd | 52 +
man/treeVec.Rd | 48 +
man/treespace.Rd | 73 +
man/treespaceServer.Rd | 20 +
man/wiwMedTree.Rd | 44 +
man/wiwTreeDist.Rd | 36 +
man/woodmiceTrees.Rd | 27 +
src/CPP_update_combinations.cpp | 31 +
src/RcppExports.cpp | 23 +
src/treespace_init.c | 22 +
tests/testthat.R | 4 +
tests/testthat/testbasics.R | 136 +
vignettes/DengueVignette.Rmd | 338 ++
vignettes/TransmissionTreesVignette.Rmd | 214 ++
vignettes/figs/BEASTtree_diffs-1.png | Bin 0 -> 54262 bytes
vignettes/figs/BEASTtree_diffs-2.png | Bin 0 -> 47439 bytes
vignettes/figs/compare_BEAST_to_other_trees-1.png | Bin 0 -> 56857 bytes
vignettes/figs/compare_BEAST_to_other_trees-2.png | Bin 0 -> 61394 bytes
vignettes/figs/compare_BEAST_to_other_trees-3.png | Bin 0 -> 48602 bytes
vignettes/figs/compare_trees_NJ_v_ML-1.png | Bin 0 -> 55699 bytes
vignettes/figs/construction.png | Bin 0 -> 226163 bytes
vignettes/figs/distances-1.png | Bin 0 -> 7758 bytes
vignettes/figs/distances-2.png | Bin 0 -> 123667 bytes
vignettes/figs/distances_readme-1.png | Bin 0 -> 4054 bytes
vignettes/figs/distances_readme-2.png | Bin 0 -> 55932 bytes
.../figs/findgroves-with-emphasis_readme-1.png | Bin 0 -> 25409 bytes
vignettes/figs/igraph_options-1.png | Bin 0 -> 4217 bytes
vignettes/figs/igraph_tree1-1.png | Bin 0 -> 15466 bytes
vignettes/figs/make_NJ-1.png | Bin 0 -> 11260 bytes
vignettes/figs/plotgroves-1.png | Bin 0 -> 17527 bytes
vignettes/figs/plotgroves2_readme-1.png | Bin 0 -> 41005 bytes
vignettes/figs/plotgroves2_readme-2.png | Bin 0 -> 38769 bytes
vignettes/figs/plotgroves2_readme-3.png | Bin 0 -> 43021 bytes
vignettes/figs/plotgroves_readme-1.png | Bin 0 -> 12538 bytes
vignettes/figs/scree_plot-1.png | Bin 0 -> 8435 bytes
vignettes/figs/see_ML_boots-1.png | Bin 0 -> 13410 bytes
vignettes/figs/see_NJ_boots-1.png | Bin 0 -> 45131 bytes
vignettes/figs/trees2_and_3-1.png | Bin 0 -> 15919 bytes
vignettes/figs/trees2_and_3-2.png | Bin 0 -> 16359 bytes
vignettes/figs/treespace3d.png | Bin 0 -> 84739 bytes
vignettes/figs/treespaceDensiTree.png | Bin 0 -> 67644 bytes
vignettes/figs/treespaceTree.png | Bin 0 -> 54253 bytes
vignettes/figs/view_ML-1.png | Bin 0 -> 11546 bytes
vignettes/figs/wiwMedTreePlot-1.png | Bin 0 -> 24810 bytes
vignettes/figs/wiw_MDS1000-1.png | Bin 0 -> 36085 bytes
vignettes/figs/woodmice-tip-emphasis_readme-1.png | Bin 0 -> 10027 bytes
vignettes/figs/woodmiceCluster1-1.png | Bin 0 -> 17112 bytes
vignettes/figs/woodmiceCluster1_readme-1.png | Bin 0 -> 11855 bytes
vignettes/figs/woodmiceMedian-1.png | Bin 0 -> 15715 bytes
vignettes/figs/woodmiceMedian_readme-1.png | Bin 0 -> 10968 bytes
vignettes/figs/woodmicePlots_readme-1.png | Bin 0 -> 13760 bytes
vignettes/figs/woodmicePlots_readme-2.png | Bin 0 -> 25518 bytes
vignettes/figs/woodmicePlots_readme-3.png | Bin 0 -> 42873 bytes
vignettes/figs/woodmice_plotTreeDiff-1.png | Bin 0 -> 31386 bytes
vignettes/figs/woodmice_plotTreeDiff-2.png | Bin 0 -> 56665 bytes
vignettes/figs/woodmice_plotTreeDiff_readme-1.png | Bin 0 -> 21972 bytes
vignettes/figs/woodmice_plotTreeDiff_readme-2.png | Bin 0 -> 38500 bytes
vignettes/introduction.Rmd | 395 +++
109 files changed, 12279 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..d0641b4
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,34 @@
+Package: treespace
+Title: Statistical Exploration of Landscapes of Phylogenetic Trees
+Version: 1.0.0
+Date: 2017-03-15
+Authors at R: c(TJ = person("Thibaut", "Jombart", email="thibautjombart at gmail.com", role = c("aut", "cre")),
+ MK = person("Michelle", "Kendall", email="m.kendall at imperial.ac.uk", role = "aut"),
+ JAG = person("Jacob", "Almagro-Garcia", role = "aut"),
+ CC = person("Caroline", "Colijn", role = "aut"))
+Maintainer: Thibaut Jombart <thibautjombart at gmail.com>
+Description: Tools for the exploration of distributions of phylogenetic trees.
+ This package includes a shiny interface which can be started from R using
+ 'treespaceServer()'.
+Depends: R (>= 3.1.2), ape, ade4
+Imports: adegenet, adegraphics, adephylo, combinat, compiler, distory,
+ fields, htmlwidgets, MASS, phangorn, Rcpp, RLumShiny,
+ scatterD3, shiny, shinyBS, utils
+LinkingTo: Rcpp
+Suggests: igraph, RColorBrewer, ggplot2, testthat, knitr, rmarkdown,
+ rgl
+License: MIT + file LICENSE
+LazyData: true
+Collate: RcppExports.R metrics.R medTree.R treespace.R findGroves.R
+ plotGroves.R plotTreeDiff.R servers.R transmissionTrees.R
+ data.R
+RoxygenNote: 6.0.1
+VignetteBuilder: knitr
+NeedsCompilation: yes
+Packaged: 2017-03-16 17:00:55 UTC; thibaut
+Author: Thibaut Jombart [aut, cre],
+ Michelle Kendall [aut],
+ Jacob Almagro-Garcia [aut],
+ Caroline Colijn [aut]
+Repository: CRAN
+Date/Publication: 2017-03-17 07:24:30 UTC
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..677887d
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2016
+COPYRIGHT HOLDER: Thibaut Jombart and Michelle Kendall
\ No newline at end of file
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..8e38c04
--- /dev/null
+++ b/MD5
@@ -0,0 +1,108 @@
+ef7333ebdaa715e679adc12587e28937 *DESCRIPTION
+aeb3d3525f92d4b2ae0659a9d9cb593b *LICENSE
+541c64335137420d2903a2f16eb558e9 *NAMESPACE
+513bf4b0b310a10f56a1b48c7789f759 *R/RcppExports.R
+4d37f548893c52bcb32eaaa096e830ef *R/data.R
+5d53b69b4abe1eff03d5ac9917a733a0 *R/findGroves.R
+b5cb61e857fe552beb7d6f1a21deff0c *R/medTree.R
+823026da119c4ed3ce1e8caa6b2b09ea *R/metrics.R
+76eb5cba87cc53f5570e3b60ea2cc020 *R/plotGroves.R
+a83358b9ee1ffcdabd283f795c6b1b3d *R/plotTreeDiff.R
+3d267930cddbb549e8de7cb9974078aa *R/servers.R
+626965bc80ff03b1e486ca1744099951 *R/transmissionTrees.R
+1115fb1e34a51ee8b9621fd2087db961 *R/treespace.R
+86cae96a8f553e867ea818a188f55ba6 *README.md
+ed976b9060b5591cfe9963568bb28b41 *build/vignette.rds
+bcff1609e140336bd432e12db7117aff *data/DengueBEASTMCC.RData
+6583dbfac178bfb8917064bbf7223322 *data/DengueSeqs.RData
+299b7355fff5403a772233c164e15c25 *data/DengueTrees.RData
+a2159a501647d1d620de2a90d1e29c32 *data/fluTrees.RData
+4b283219478dd962374a26476d5206fd *data/woodmiceTrees.RData
+0894c52a5f25667c0231a2c5f04cb4d0 *inst/doc/DengueVignette.R
+f17db7f7894a6fe2291d571348d95ca2 *inst/doc/DengueVignette.Rmd
+24ac89f2039167b52257e3f326c6aa51 *inst/doc/DengueVignette.html
+f9ff4b693bb273c56bd19d54c4ecfbed *inst/doc/TransmissionTreesVignette.R
+279ba230b144991db76aef5d67cd34e2 *inst/doc/TransmissionTreesVignette.Rmd
+daac10ad341f9ee6b38de5f36c052703 *inst/doc/TransmissionTreesVignette.html
+1a2b6938a72c643ad9fc2d748f7b01f8 *inst/doc/introduction.R
+dfdf468cc194071645e497d92287a2da *inst/doc/introduction.Rmd
+e86bc049fdf9f2eb4eb33972be910a0d *inst/doc/introduction.html
+a49efdba2480901c948a5458c5cfd19a *inst/shiny/server.R
+2fae9281359e14a0701b3b6a2a071a98 *inst/shiny/ui.R
+6c4711607de1791415c5b50511e84ad3 *inst/shiny/www/bootstrap.simplex.css
+dc516afa494d9430a94c9fb23fc6aa97 *inst/shiny/www/html/help.html
+d8684ae68cfdcc9049f1ff417ce3c3eb *inst/shiny/www/img/line.png
+c3d0c3d454439e0980a1a2af2b355ca8 *inst/shiny/www/img/logo.png
+96abc4b41da8cafa6f565bf5604b460c *inst/shiny/www/styles.css
+095129a1994251eec286d5bc3f3fce98 *man/DengueBEASTMCC.Rd
+91697d211ad4230586806881efb444da *man/DengueSeqs.Rd
+1fb6214a402808562b962f6ff0ab9db2 *man/DengueTrees.Rd
+44b9c8391dda972b5298c0b98fd4dccd *man/findGroves.Rd
+fa2b5fef986c8fb22939a42513bb7f43 *man/findMRCIs.Rd
+5368ab087178daccfda6080c2cc7a4f6 *man/fluTrees.Rd
+cb81f4960674bf2be0843a85e03e820b *man/linearMrca.Rd
+6eb5452f9df5aa4fa165a2a53c60f16e *man/medTree.Rd
+3c7119f193b39f8ebfd8ce259d61248d *man/multiDist.Rd
+2b399278b9c70facffb2cd97efae23bd *man/plotGroves.Rd
+88f5d0ed2e6e13777e930bcc69fca3ff *man/plotGrovesD3.Rd
+977107022b64fefb1ebc225d31eafed2 *man/plotTreeDiff.Rd
+f1ff6be3e9debb74626d75ac60aa2e33 *man/refTreeDist.Rd
+2fe8856726efa7bb0ff40aaf0575426c *man/tipDiff.Rd
+716fc0346279155278746206a90a8c6b *man/treeDist.Rd
+033c781e86085e130696b3df0b1c1e3d *man/treeVec.Rd
+fe55c4c9f9cbb71f8ae667fead802a51 *man/treespace.Rd
+ec2bc877c94fef4eb173e9a61cd1eb09 *man/treespaceServer.Rd
+a77475898bc5833024c09c0dc37869db *man/wiwMedTree.Rd
+81d99a24989b6bd9bc217ca56b1e1bb1 *man/wiwTreeDist.Rd
+ee53473c06ed9d4d1bba201c55995879 *man/woodmiceTrees.Rd
+9c74c81eeaf5d8af22cd33dab4daffcc *src/CPP_update_combinations.cpp
+1976b5f5098a4e7cda28aab94ac9ff0c *src/RcppExports.cpp
+3cd3f6abd34189affceb7002359fd292 *src/treespace_init.c
+d3250417a44742de696377e9f7f9cb46 *tests/testthat.R
+c98ad82c3fede784144d1a89de4054cf *tests/testthat/testbasics.R
+f17db7f7894a6fe2291d571348d95ca2 *vignettes/DengueVignette.Rmd
+279ba230b144991db76aef5d67cd34e2 *vignettes/TransmissionTreesVignette.Rmd
+c40f2231c22f94bf9b3036461c5504b2 *vignettes/figs/BEASTtree_diffs-1.png
+964108c7a57b5ae5266ac53274bafbc5 *vignettes/figs/BEASTtree_diffs-2.png
+abe7af2466cf520464dc904dd87cbfa6 *vignettes/figs/compare_BEAST_to_other_trees-1.png
+105765a63b9d994d264436ef48594d99 *vignettes/figs/compare_BEAST_to_other_trees-2.png
+a6d84b57f3b4f419d5087b05349ff8ef *vignettes/figs/compare_BEAST_to_other_trees-3.png
+979955764971e0ffba98c3b8255d17a6 *vignettes/figs/compare_trees_NJ_v_ML-1.png
+d7d0f02319a4fcc003bed10e738c9d5f *vignettes/figs/construction.png
+5a06e0ebae0593fe7a9a03dedeb34526 *vignettes/figs/distances-1.png
+f02eb5f3ce732d74d506a58658d94aed *vignettes/figs/distances-2.png
+9d751543c51335a0aff2a82d32647370 *vignettes/figs/distances_readme-1.png
+88b11b6f51e21345be1fd8bafa31a279 *vignettes/figs/distances_readme-2.png
+56a8de03d01520574f7f6deb83dc09a8 *vignettes/figs/findgroves-with-emphasis_readme-1.png
+25f2477bb49002195ffe945d1f3ca698 *vignettes/figs/igraph_options-1.png
+4584c27049a19698107a79b9b26b6961 *vignettes/figs/igraph_tree1-1.png
+e59a52e5379fb3823e50377a8387f58f *vignettes/figs/make_NJ-1.png
+3e103d7f4edf67d85910430a86529162 *vignettes/figs/plotgroves-1.png
+4831761d443daec1832115749111b650 *vignettes/figs/plotgroves2_readme-1.png
+3c8d0609fb3927e983acbd0e1ddb2abd *vignettes/figs/plotgroves2_readme-2.png
+a53902c75200510cf36550d5fb6548c4 *vignettes/figs/plotgroves2_readme-3.png
+81ff60166990b9383c139901aab6d593 *vignettes/figs/plotgroves_readme-1.png
+342ffa7032b079d2f99325c03e4b0359 *vignettes/figs/scree_plot-1.png
+85c973c1060fabde2d9e395f8081ca46 *vignettes/figs/see_ML_boots-1.png
+31f2b3ae0bda7057c874b3980ece9ac4 *vignettes/figs/see_NJ_boots-1.png
+cd0051f975254687dd735e2c9b13749d *vignettes/figs/trees2_and_3-1.png
+dd701c13f8451f952bfaea1491cbd955 *vignettes/figs/trees2_and_3-2.png
+dece84f823670ff0e7257cc643bf068b *vignettes/figs/treespace3d.png
+3957a3c2207cd065f1d95cc704ebaa7d *vignettes/figs/treespaceDensiTree.png
+32257dc64bf2670d28770a4679f063a7 *vignettes/figs/treespaceTree.png
+8b31dc89bb6505f315633cf746059045 *vignettes/figs/view_ML-1.png
+17da5158b60832defe3ead8e10999f6e *vignettes/figs/wiwMedTreePlot-1.png
+da8f987200d5c2e40b6362372c4c013b *vignettes/figs/wiw_MDS1000-1.png
+7dc88e52020d8238ffb4cdab49626e41 *vignettes/figs/woodmice-tip-emphasis_readme-1.png
+c143c322b3edcdf107f62e659180fa81 *vignettes/figs/woodmiceCluster1-1.png
+ab0985e8095fb910b2ad1856782b7d14 *vignettes/figs/woodmiceCluster1_readme-1.png
+2df84ea0fd09a98b33454df3332df3a5 *vignettes/figs/woodmiceMedian-1.png
+ef518521ce15ccccddc92c2823eb1f7b *vignettes/figs/woodmiceMedian_readme-1.png
+27f232eb46a71e8d64a7055c14960042 *vignettes/figs/woodmicePlots_readme-1.png
+3949e7ccccf70ad2de3326e78231347f *vignettes/figs/woodmicePlots_readme-2.png
+77cc6241293a3ae7015c9624320322cd *vignettes/figs/woodmicePlots_readme-3.png
+3a1d0357e2492211b9040290a56ddec1 *vignettes/figs/woodmice_plotTreeDiff-1.png
+fe7c4be7d20e6c6ee17b6cc4518f6a55 *vignettes/figs/woodmice_plotTreeDiff-2.png
+b46dc942c6cddb66410ec6c103c3e041 *vignettes/figs/woodmice_plotTreeDiff_readme-1.png
+ce99f8bdce61587038cf9c1e7ffc5135 *vignettes/figs/woodmice_plotTreeDiff_readme-2.png
+dfdf468cc194071645e497d92287a2da *vignettes/introduction.Rmd
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..7b1f8a8
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,61 @@
+# Generated by roxygen2: do not edit by hand
+
+export(.render.server.info)
+export(findGroves)
+export(findMRCIs)
+export(linearMrca)
+export(medTree)
+export(multiDist)
+export(plotGroves)
+export(plotGrovesD3)
+export(plotTreeDiff)
+export(refTreeDist)
+export(tipDiff)
+export(treeDist)
+export(treeVec)
+export(treespace)
+export(treespaceServer)
+export(wiwMedTree)
+export(wiwTreeDist)
+import(ape)
+import(scatterD3)
+import(shiny)
+importFrom(MASS,Shepard)
+importFrom(RLumShiny,jscolorInput)
+importFrom(Rcpp,evalCpp)
+importFrom(ade4,cailliez)
+importFrom(ade4,dudi.pco)
+importFrom(adegenet,.readExt)
+importFrom(adegenet,bluepal)
+importFrom(adegenet,funky)
+importFrom(adegenet,lightseasun)
+importFrom(adegenet,num2col)
+importFrom(adegenet,transp)
+importFrom(adegraphics,insert)
+importFrom(adegraphics,s.class)
+importFrom(adegraphics,s.label)
+importFrom(adegraphics,s1d.barchart)
+importFrom(adephylo,distTips)
+importFrom(combinat,combn)
+importFrom(combinat,combn2)
+importFrom(compiler,cmpfun)
+importFrom(distory,dist.multiPhylo)
+importFrom(fields,rdist)
+importFrom(grDevices,colorRampPalette)
+importFrom(graphics,abline)
+importFrom(graphics,layout)
+importFrom(graphics,plot)
+importFrom(htmlwidgets,saveWidget)
+importFrom(phangorn,Children)
+importFrom(phangorn,Descendants)
+importFrom(phangorn,KF.dist)
+importFrom(phangorn,RF.dist)
+importFrom(phangorn,path.dist)
+importFrom(phangorn,wRF.dist)
+importFrom(shinyBS,bsTooltip)
+importFrom(stats,as.dist)
+importFrom(stats,cutree)
+importFrom(stats,dist)
+importFrom(stats,hclust)
+importFrom(utils,packageDescription)
+useDynLib(treespace)
diff --git a/R/RcppExports.R b/R/RcppExports.R
new file mode 100644
index 0000000..337db2c
--- /dev/null
+++ b/R/RcppExports.R
@@ -0,0 +1,7 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+updateDistancesWithCombinations <- function(length_root_distances, topological_root_distances, left_partition, right_partition, index_offsets, distance_to_root, edges_to_root) {
+ invisible(.Call('treespace_updateDistancesWithCombinations', PACKAGE = 'treespace', length_root_distances, topological_root_distances, left_partition, right_partition, index_offsets, distance_to_root, edges_to_root))
+}
+
diff --git a/R/data.R b/R/data.R
new file mode 100644
index 0000000..e23e928
--- /dev/null
+++ b/R/data.R
@@ -0,0 +1,93 @@
+#' Bootstrap trees from woodmouse dataset
+#'
+#' These trees were created using the neighbour-joining and bootstrapping
+#' example from the ape documentation.
+#'
+#'
+#' @name woodmiceTrees
+#' @docType data
+#' @format A multiPhylo object containing 201 trees, each with 15 tips
+#' @references Michaux, J. R., Magnanou, E., Paradis, E., Nieberding, C. and
+#' Libois, R. (2003) Mitochondrial phylogeography of the Woodmouse (Apodemus
+#' sylvaticus) in the Western Palearctic region. \emph{Molecular Ecology}, 12,
+#' 685-697
+#' @source A set of 15 sequences of the mitochondrial gene cytochrome b of the
+#' woodmouse (Apodemus sylvaticus) which is a subset of the data analysed by
+#' Michaux et al. (2003). The full data set is available through GenBank
+#' (accession numbers AJ511877 to AJ511987)
+#' @keywords datasets
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+NULL
+
+
+#' BEAST analysis of seasonal influenza (A/H3N2)
+#'
+#' These trees were created using BEAST on hemagglutinin (HA) segments
+#' of seasonal influenza A/H3N2 samples collected in New-York city (US) between 2000 and 2003. This data comes from the influenza BEAST tutorial distributed at:
+#' http://beast.bio.ed.ac.uk/tutorials
+#'
+#' Only the first 200 trees (out of 10,000) were retained.
+#'
+#' @name fluTrees
+#' @docType data
+#' @format A multiPhylo object containing 200 trees, each with 165 tips
+#' @references http://beast.bio.ed.ac.uk/tutorials
+#' @source http://beast.bio.ed.ac.uk/tutorials
+#' @keywords datasets
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+NULL
+
+#' Dengue fever sequences
+#'
+#' 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997)
+#'
+#' @name DengueSeqs
+#' @docType data
+#' @format A DNAbin object containing 17 DNA sequences, each of length 1485.
+#' @references Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+#' Molecular evolution and phylogeny of dengue-4 viruses.
+#' \emph{Journal of General Virology}, 78(9), 2279-2286.
+#' @source http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+#' @keywords datasets
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+NULL
+
+#' BEAST analysis of Dengue fever
+#'
+#' These trees were created using one of the \code{xml} files provided with the original BEAST paper by Drummond and Rambaut (2007).
+#' They provide an example of 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997) (available as \code{\link{DengueSeqs}}) and \code{xml} files with varying priors for model and clock rate.
+#' Here we include a random sample of 500 of the trees (from the second half of the posterior) produced using BEAST v1.8 with the standard GTR + Gamma + I substitution model with uncorrelated lognormal-distributed relaxed molecular clock (file 4).
+#'
+#' @name DengueTrees
+#' @docType data
+#' @format A multiPhylo object containing 500 trees, each with 17 tips
+#' @references Drummond, A. J., and Rambaut, A. (2007)
+#' BEAST: Bayesian evolutionary analysis by sampling trees.
+#' \emph{BMC Evolutionary Biology}, 7(1), 214.
+#'
+#' Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+#' Molecular evolution and phylogeny of dengue-4 viruses.
+#' \emph{Journal of General Virology}, 78(9), 2279-2286.
+#' @source http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+#' @keywords datasets
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+NULL
+
+#' Dengue fever BEAST MCC tree
+#'
+#' The maximum clade credibility (MCC) tree from \code{\link{DengueTrees}}
+#'
+#' @name DengueBEASTMCC
+#' @docType data
+#' @format A phylo object
+#' @references Drummond, A. J., and Rambaut, A. (2007)
+#' BEAST: Bayesian evolutionary analysis by sampling trees.
+#' \emph{BMC Evolutionary Biology}, 7(1), 214.
+#'
+#' Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+#' Molecular evolution and phylogeny of dengue-4 viruses.
+#' \emph{Journal of General Virology}, 78(9), 2279-2286.
+#' @source http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+#' @keywords datasets
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+NULL
\ No newline at end of file
diff --git a/R/findGroves.R b/R/findGroves.R
new file mode 100644
index 0000000..4a753a8
--- /dev/null
+++ b/R/findGroves.R
@@ -0,0 +1,100 @@
+##'
+#' Identify clusters of similar trees
+#'
+#' This function uses hierarchical clustering on principal components output by \code{\link{treespace}} to identify groups of similar trees. Clustering relies on \code{\link{hclust}}, using Ward's method by default.
+#'
+#' @param x an object of the class multiPhylo or the output of the function \code{treespace}
+#' @param method (ignored if x is from \code{treespace}) this specifies a function which outputs the summary of a tree in the form of a vector. Defaults to \code{treeVec}.
+#' @param nf (ignored if x is from \code{treespace}) the number of principal components to retain
+#' @param clustering a character string indicating the clustering method to be used; defaults to Ward's method; see argument \code{method} in \code{?hclust} for more details.
+#' @param nclust an integer indicating the number of clusters to find; if not provided, an interactive process based on cutoff threshold selection is used.
+#' @param ... further arguments to be passed to \code{treespace}
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @import ape
+#' @importFrom stats hclust
+#' @importFrom stats dist
+#' @importFrom stats cutree
+#' @importFrom graphics plot
+#' @importFrom graphics abline
+#'
+#'
+#' @seealso \code{\link{plotGroves}} to display results
+#'
+#' @return
+#' A list containing:
+#' \itemize{
+#' \item groups: a factor defining groups of trees
+#' \item treespace: the output of treespace
+#' }
+#'
+#' @examples
+#'
+#' if(require("adegenet") && require("adegraphics")){
+#' ## load data
+#' data(woodmiceTrees)
+#'
+#' ## run findGroves: treespace+clustering
+#' res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+#'
+#' ## plot results on first 2 axes
+#' PCs <- res$treespace$pco$li
+#' s.class(PCs, fac=res$groups, col=funky(6))
+#'
+#' ## using plotGroves
+#' plotGroves(res)
+#' }
+#'
+#'
+#' @export
+findGroves <- function(x, method="treeVec", nf=NULL, clustering="ward.D2",
+ nclust=NULL, ...){
+ ## CHECK input type ##
+ if (inherits(x, "multiPhylo")) {
+ ## GET OUTPUT OF TREESPACE ##
+ type <- "multiPhylo_object"
+ res <- treespace(x, method=method, nf=nf, ...)
+ }
+ else if (inherits(x, "list")) {
+ # test if it is an output from treespace
+ inherits(x$D,"dist")
+ inherits(x$pco,c("pco","dudi"))
+ type <- "treespace_output"
+ res <- x
+ }
+ else stop("x should be a multiphylo object or output of function treespace")
+
+ ## GET CLUSTERS ##
+ ## hierharchical clustering
+ clust <- hclust(dist(res$pco$li), method=clustering)
+
+ ## select nclust interactively if needed
+ if(is.null(nclust)){
+ ans <- NA
+ continue <- TRUE
+ while(is.na(ans) || continue){
+ plot(clust)
+ cat("\nPlease define a cutoff point: ")
+ ans <- as.double(readLines(n = 1))
+ abline(h=ans, col="royalblue", lty=2)
+ cat("\nAre you happy with this choice (y/n): ")
+ continue <- as.character(readLines(n = 1))!="y"
+ }
+ grp <- cutree(clust, h=ans)
+ } else {
+ ## cut tree
+ grp <- cutree(clust, k=nclust)
+ }
+
+ ## BUILD RESULT AND RETURN ##
+ # retrieve tree names:
+ if (type=="multiPhylo_object") names(grp) <- names(x)
+ if (type=="treespace_output") names(grp) <- colnames(as.matrix(x$D))
+
+ out <- list(groups=factor(grp), treespace=res)
+
+ return(out)
+} # end findGroves
+
diff --git a/R/medTree.R b/R/medTree.R
new file mode 100644
index 0000000..76efb92
--- /dev/null
+++ b/R/medTree.R
@@ -0,0 +1,218 @@
+#' Geometric median tree function
+#'
+#' Finds the geometric median of a set of trees according to the Kendall Colijn metric.
+#'
+#' @author Jacob Almagro-Garcia \email{nativecoder@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#'
+#' @param x A list of trees of the class multiPhylo, for which the median tree will be computed, \cr
+#' OR a matrix of tree vectors as given by \code{treespace$vectors}.
+#' @param groups an optional factor defining groups of trees; if provided, one median tree will be found for each group.
+#' @param lambda a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE} or if the vectors are already supplied as the object \code{x}.
+#' @param weights A vector of weights for the trees. Defaults to a vector of 1's so that all trees are equally weighted, but can be used to encode likelihood, posterior probabilities or other characteristics.
+#' @param emphasise.tips an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.
+#' @param emphasise.weight applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.
+#' @param return.lambda.function If true, a function that can be invoked with different lambda values is returned.
+#' This function returns the vector of metric values for the given lambda. Ignored if the tree vectors are already supplied as the object \code{x}.
+#' @param save.memory A flag that saves a lot of memory but increases the execution time (not compatible with return.lambda.function=TRUE). Ignored if the tree vectors are already supplied as the object \code{x}.
+#'
+#' @return A list of five objects:
+#' \itemize{
+#' \item $centre is the "central vector", that is, the (weighted) mean of the tree vectors (which typically does not correspond to a tree itself);
+#' \item $distances gives the distance of each tree from the central vector;
+#' \item $mindist is the minimum of these distances;
+#' \item $treenumbers gives the numbers (and, if supplied, names) of the "median tree(s)", that is, the tree(s) which achieve this minimum distance to the centre;
+#' \item $trees if trees were supplied then this returns the median trees as a multiPhylo object.
+#' }
+#' If groups are provided, then one list is returned for each group.
+#' If \code{return.lambda.function=TRUE} then a function is returned that produces this list for a given value of lambda.
+#'
+#'
+#' @import ape
+#'
+#'
+#' @examples
+#'
+#' ## EXAMPLE WITH WOODMICE DATA
+#' data(woodmiceTrees)
+#'
+#' ## LOOKING FOR A SINGLE MEDIAN
+#' ## get median tree(s)
+#' res <- medTree(woodmiceTrees)
+#' res
+#'
+#' ## plot first tree
+#' med.tree <- res$trees[[1]]
+#' plot(med.tree)
+#'
+#' ## LOOKING FOR MEDIANS IN SEVERAL CLUSTERS
+#' ## identify 6 clusters
+#' groves <- findGroves(woodmiceTrees, nf=3, nclust=6)
+#'
+#' ## find median trees
+#' res.with.grp <- medTree(woodmiceTrees, groves$groups)
+#'
+#' ## there is one output per cluster
+#' names(res.with.grp)
+#'
+#' ## get the first median of each
+#' med.trees <- lapply(res.with.grp, function(e) ladderize(e$trees[[1]]))
+#'
+#' ## plot trees
+#' par(mfrow=c(2,3))
+#' for(i in 1:length(med.trees)) plot(med.trees[[i]], main=paste("cluster",i))
+#'
+#' ## highlight the differences between a pair of median trees
+#' plotTreeDiff(med.trees[[1]],med.trees[[5]])
+#'
+#' @export
+medTree <- function(x, groups=NULL, lambda=0, weights=NULL, emphasise.tips=NULL, emphasise.weight=2,
+ return.lambda.function=FALSE, save.memory=FALSE) {
+
+ ## CHECK input type ##
+ if (inherits(x, "multiPhylo")) {
+ type <- "multiPhylo_object"
+ }
+ else if (inherits(x, "matrix")) {
+ # x is a matrix of tree vectors
+ type <- "tree_vectors"
+ }
+ else stop("x should be a multiphylo object or a matrix of tree vectors")
+
+if (type=="multiPhylo_object") {
+ ## DEFINE MAIN FUNCTION FINDING MEDIAN TREE ##
+ findMedianPhylo <- function(trees, weights){
+ ## checks, general variables
+ num_trees <- length(trees)
+ num_leaves <- length(trees[[1]]$tip.label)
+ if(is.null(weights)) weights <- rep(1, num_trees)
+ if(length(weights)!=num_trees) stop("Length of vector of weights must be the same as number of trees")
+
+ ## Working with numbers (no functions).
+ if(!return.lambda.function) {
+
+ ## Here we speed up the computation by storing all vectors (a lot of memory for big trees).
+ if(!save.memory) {
+
+ ## Compute the metric vector for all trees.
+ tree_metrics <- t(sapply(trees, function(tree) {treeVec(tree, lambda, emphasise.tips, emphasise.weight, return.lambda.function=F)}))
+
+ ## Compute the centre metric vector by weighting the metric vector of each tree.
+ centre <- (weights %*% tree_metrics)/num_trees
+
+ ## Distances to the centre.
+ distances <- apply(tree_metrics, 1, function(m){sqrt(sum((m-centre)^2))})
+
+ ## Get the indices for the median tree(s).
+ min_distance <- min(distances)
+ median_trees <- which(min_distance == distances)
+
+ return(list(centre=centre, distances=distances, mindist=min_distance, treenumbers=median_trees, trees=trees[median_trees]))
+ }
+
+ ## To save memory we recompute the vectors on the fly (way slower but we don't eat a ton of memory).
+ ## We'll need a first pass to compute the centre and a second pass to compute distances.
+ else {
+
+ ## First pass: compute the centre.
+ centre <- rep(0,(num_leaves*(num_leaves-1)/2) + num_leaves)
+ for(i in 1:num_trees) {
+ centre <- centre + treeVec(trees[[i]], lambda, F) * weights[i]
+ }
+ centre <- centre/num_trees
+
+ ## Second pass: compute the distances.
+ distances <- rep(NA,num_trees)
+ for(i in 1:num_trees) {
+ distances[i] <- sqrt(sum((treeVec(trees[[i]], lambda, F) - centre)^2))
+ }
+
+ ## Get the indices for the median tree(s).
+ min_distance <- min(distances)
+ median_trees <- which(min_distance == distances)
+
+ return(list(centre=centre, distances=distances, mindist=min_distance, treenumbers=median_trees, trees=trees[median_trees]))
+ }
+ }
+
+ ## Working with functions.
+ else {
+
+ if(save.memory)
+ warning("save.memory=TRUE is incompatible with return.lambda.function=TRUE, setting save.memory=FALSE")
+
+ ## Compute the list of metric functions for all trees.
+ tree_metric_functions <- sapply(trees, function(tree) {treeVec(tree, lambda, emphasise.tips, emphasise.weight, return.lambda.function=T)})
+
+ ## Inner function that we'll return, computes the distance matrix given lambda.
+ compute_median_tree_function <- function(l) {
+
+ ## Compute the tree metrics for the given lambda.
+ tree_metrics <- t(sapply(tree_metric_functions, function(tmf){tmf(l)}))
+
+ ## Compute the centre metric vector by weighting the metric vector of each tree.
+ centre <- (weights %*% tree_metrics)/num_trees
+
+ ## Distances to the centre.
+ distances <- apply(tree_metrics, 1, function(m){sqrt(sum((m-centre)^2))})
+
+ ## Get the indices for the median tree(s).
+ min_distance <- min(distances)
+ median_trees <- which(min_distance == distances)
+
+ return(list(centre=centre, distances=distances, mindist=min_distance, treenumbers=median_trees, trees=trees[median_trees]))
+ }
+
+ return(compute_median_tree_function)
+ }
+ } # end findMedian
+
+
+ ## APPLY FUNCTION TO TREES ##
+ if(is.null(groups)){ ## no groups provided
+ out <- findMedianPhylo(x, weights)
+ } else { ## groups provided
+ out <- tapply(x, groups, findMedianPhylo, weights)
+ }
+} # end if multiPhylo object
+
+if (type=="tree_vectors"){
+ ## Can define a much simpler version of the function to find a median tree ##
+ findMedianVectors <- function(vectors, weights){
+ ## checks, general variables
+ num_trees <- length(vectors[,1])
+ if(is.null(weights)) {weights <- rep(1,num_trees)}
+ if(length(weights)!=num_trees) stop("Length of vector of weights must be the same as number of tree vectors")
+
+ tree_metrics <- vectors
+
+ ## Compute the centre metric vector by weighting the metric vector of each tree.
+ centre <- (weights %*% tree_metrics)/num_trees
+
+ ## Distances to the centre.
+ distances <- apply(tree_metrics, 1, function(m){sqrt(sum((m-centre)^2))})
+
+ ## Get the indices for the median tree(s).
+ min_distance <- min(distances)
+ median_trees <- which(min_distance == distances)
+
+ ## Note we cannot return $trees because the trees were not supplied!
+ return(list(centre=centre, distances=distances, mindist=min_distance, treenumbers=median_trees))
+ } # end findMedianVectors
+
+
+ ## APPLY FUNCTION TO TREES ##
+ if(is.null(groups)){ ## no groups provided
+ out <- findMedianVectors(x, weights)
+ } else { ## groups provided
+ # need to first convert the vector matrix into a list:
+ mylist <- lapply(1:length(x[,1]), function(a) x[a,])
+ # and then coerce back into matrix within the function.
+ # Room for improvement here!
+ out <- tapply(mylist, groups, function(a) {findMedianVectors(t(sapply(a, function(b) b)), weights)})
+ }
+}
+ ## RETURN ##
+ return(out)
+} ## end medTree
diff --git a/R/metrics.R b/R/metrics.R
new file mode 100644
index 0000000..82cd255
--- /dev/null
+++ b/R/metrics.R
@@ -0,0 +1,506 @@
+#' Linear MRCA function
+#'
+#' Function to make the most recent common ancestor (MRCA) matrix of a tree, where entry (i,j) gives the MRCA of tips i and j.
+#' The function is linear, exploiting the fact that the tree is rooted.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param tree an object of the class \code{phylo} which should be rooted.
+#' @param k (optional) number of tips in tree, for faster computation
+#'
+#' @importFrom phangorn Descendants
+#' @importFrom phangorn Children
+#' @importFrom combinat combn
+#' @importFrom compiler cmpfun
+#'
+#' @examples
+#'
+#' ## generate a random tree
+#' x <- rtree(6)
+#'
+#' ## create matrix of MRCAs: entry (i,j) is the node number of the MRCA of tips i and j
+#' linearMrca(x,6)
+#'
+#'
+#' @export
+linearMrca <- function(tree,k=0) { # k is number of tips, which can be passed to the function to save on computation
+ if(!is.rooted(tree)){stop("This function requires the tree to be rooted")}
+ if (k==0) {k <- length(tree$tip.label)}
+ M <- matrix(0, nrow=k, ncol=k); # initialise matrix
+ T <- tree$Nnode # total number of internal nodes
+ # traverse internal nodes from root down
+ for (tmp in (k+1):(k+T)){
+ # find the children of tmp. Then tmp is the MRCA of all pairs of tips descending from different children
+ tmp.desc <- Children(tree,tmp)
+ Desc <- sapply(1:length(tmp.desc), function(x) Descendants(tree,tmp.desc[[x]],type="tips"))
+ if (length(tmp.desc)==2) { # tmp is the MRCA of tips descending from child one and tips from child two
+ I <- Desc[[1]]; J <- Desc[[2]]
+ for (i in I) {
+ for (j in J) {
+ M[i,j] <- M[j,i] <- tmp
+ }
+ }
+ }
+ else { # for each pair of children of tmp, tmp is the MRCA of their descendant tips
+ pairs <- combn(length(Desc),2)
+ for (p in 1:length(pairs[1,])) {
+ for (i in Desc[[pairs[1,p]]]) {
+ for (j in Desc[[pairs[2,p]]]) {
+ M[i,j] <- M[j,i] <- tmp
+ }
+ }
+ }
+ }
+ }
+ diag(M) <- 1:k # we define the diagonal elements of M to be the tips themselves
+ return(M)
+}
+linearMrca <- compiler::cmpfun(linearMrca) # compile
+
+
+#' Tree vector function
+#'
+#' Function which takes an object of class phylo and outputs the vector for the Kendall Colijn metric.
+#' The elements of the vector are numeric if \code{return.lambda.function=FALSE} (default),
+#' and otherwise they are functions of lambda.
+#'
+#' @author Jacob Almagro-Garcia \email{nativecoder@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param tree an object of the class \code{phylo}
+#' @param lambda a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.
+#' @param return.lambda.function If true, a function that can be invoked with different lambda values is returned. This function returns the vector of metric values for the given lambda.
+#' @param emphasise.tips an optional list of tips whose entries in the tree vector should be emphasised. Defaults to \code{NULL}.
+#' @param emphasise.weight applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.
+#'
+#' @return The vector of values according to the metric, or a function that produces the vector given a value of lambda.
+#'
+#' @import ape
+#' @importFrom Rcpp evalCpp
+#' @importFrom combinat combn2
+#' @useDynLib treespace
+#'
+#' @examples
+#'
+#' ## generate a random tree
+#' tree <- rtree(6)
+#' ## topological vector of mrca distances from root:
+#' treeVec(tree)
+#' ## vector of mrca distances from root when lambda=0.5:
+#' treeVec(tree,0.5)
+#' ## vector of mrca distances as a function of lambda:
+#' vecAsFunction <- treeVec(tree,return.lambda.function=TRUE)
+#' ## evaluate the vector at lambda=0.5:
+#' vecAsFunction(0.5)
+#'
+#'
+#' @export
+treeVec <- function(tree, lambda=0, return.lambda.function=FALSE, emphasise.tips=NULL, emphasise.weight=2) {
+ if(lambda<0 || lambda>1) stop("Pick lambda in [0,1]")
+ if(class(tree)!="phylo") stop("Tree should be of class phylo")
+ if(is.rooted(tree)!=TRUE) stop("Metric is for rooted trees only")
+ if(is.null(tree$edge.length)) {
+ warning("Tree edge lengths are not defined, setting edges to have length 1")
+ tree$edge.length <- rep(1,length(tree$edge))
+ }
+
+ num_leaves <- length(tree$tip.label)
+ num_edges <- nrow(tree$edge)
+
+ # We work with ordered labels, using this vector to transform indices.
+ tip_order <- match(1:num_leaves, order(tree$tip.label))
+
+ # Ordering the edges by first column places the root at the bottom.
+ # Descendants will be placed always before parents.
+ edge_order <- ape::reorder.phylo(tree, "postorder", index.only=T)
+ edges <- tree$edge[edge_order,]
+ edge_lengths <- tree$edge.length[edge_order]
+
+ # To emphasise the position of certain tips, if needed:
+ if (is.null(emphasise.tips)==FALSE){
+ # check tip labels are recognised:
+ unknownTips <- setdiff(emphasise.tips,tree$tip.label)
+ if (length(unknownTips)>0) {stop(paste('Tip "',unknownTips,'" not recognised. ', sep=''))}
+ # translate important tip label names into order
+ emphasise.tips.order <- tip_order[which(tree$tip.label%in%emphasise.tips)]
+ # find the positions where these tips appear in the k choose 2 elements of the final vector
+ pairs <- combn2(1:num_leaves)
+ emphasise.vector.elements <- union(which(pairs[,1]%in%emphasise.tips.order ),which(pairs[,2]%in%emphasise.tips.order ))
+ # make a vector to multiply positions concerning important tips by chosen weighting
+ tip.weighting <- c(sapply(1:length(pairs[,1]), function(x) if(x%in%emphasise.vector.elements){emphasise.weight} else{1}),
+ sapply(1:num_leaves, function(y) if(y%in%emphasise.tips.order){emphasise.weight} else{1}))
+ }
+ else{tip.weighting <- rep(1,0.5*num_leaves*(num_leaves+1))}
+
+
+ # We annotated the nodes of the tree in this list. In two passes we are going to
+ # compute the partition each node induces in the tips (bottom-up pass) and the distance
+ # (in branch length and number of branches) from the root to each node (top-down pass).
+ annotated_nodes <- list()
+
+ # Bottom up (compute partitions, we store the branch lengths to compute distances
+ # to the root on the way down).
+ for(i in 1:num_edges) {
+
+ parent <- edges[i,1]
+ child <- edges[i,2]
+
+ # Initialization (leaves).
+ if(child <= num_leaves) {
+ # We translate the index for the sorted labels.
+ child <- tip_order[child]
+ # Leaves have as children themselves.
+ annotated_nodes[[child]] <- list(root_distance=NULL, edges_to_root=1, partitions=list(child))
+ }
+
+ # Aggregate the children partitions (only if we are not visiting a leaf).
+ aggregated_partitions <- annotated_nodes[[child]]$partitions[[1]]
+ if((child > num_leaves)) {
+ for(p in 2:length(annotated_nodes[[child]]$partitions))
+ aggregated_partitions <- c(aggregated_partitions, annotated_nodes[[child]]$partitions[[p]])
+ }
+
+ # Update the branch length on the child.
+ annotated_nodes[[child]]$root_distance <- edge_lengths[i]
+
+ # We have not visited this internal node before.
+ if(parent > length(annotated_nodes) || is.null(annotated_nodes[[parent]])) {
+ # Assume the first time we get the left child partition.
+ annotated_nodes[[parent]] <- list(root_distance=NULL, edges_to_root=1, partitions=list(aggregated_partitions))
+ }
+ # This is not the first time we have visited the node.
+ else {
+ # We store the next partition of leaves.
+ annotated_nodes[[parent]]$partitions[[length(annotated_nodes[[parent]]$partitions)+1]] <- aggregated_partitions
+ }
+ }
+
+ # Update the distance to the root at the root (i.e. 0)
+ # And the number of edges to the root (i.e. 0).
+ annotated_nodes[[num_leaves+1]]$root_distance <- 0
+ annotated_nodes[[num_leaves+1]]$edges_to_root <- 0
+
+ # Top down, compute distances to the root for each node.
+ for(i in num_edges:1) {
+ parent <- edges[i,1]
+ child <- edges[i,2]
+
+ # If the child is a leaf we translate the index for the sorted labels.
+ if(child <= num_leaves)
+ child <- tip_order[child]
+
+ annotated_nodes[[child]]$root_distance <- annotated_nodes[[child]]$root_distance + annotated_nodes[[parent]]$root_distance
+ annotated_nodes[[child]]$edges_to_root <- annotated_nodes[[child]]$edges_to_root + annotated_nodes[[parent]]$edges_to_root
+ }
+
+ # Distance vectors
+ vector_length <- (num_leaves*(num_leaves-1)/2) + num_leaves
+ length_root_distances <- double(vector_length)
+ topological_root_distances <- integer(vector_length)
+
+ # Fill-in the leaves (notice the involved index translation for leaves).
+ topological_root_distances[(vector_length-num_leaves+1):vector_length] <- 1
+ length_root_distances[(vector_length-num_leaves+1):vector_length] <- edge_lengths[match(1:num_leaves, edges[,2])][order(tree$tip.label)]
+
+ # Instead of computing the lexicographic order for the combination pairs assume we
+ # are filling in a symmetric distance matrix (using only the triangular upper part).
+ # We just need to "roll" the matrix indices into the vector indices.
+ # Examples for (k=5)
+ # The combination c(1,4) would be located at position 3 on the vector.
+ # The combination c(2,1) would be located at position 1 on the vector because d(2,1) = d(1,2).
+ # The combination c(2,3) would be located at position 5 on the vector.
+
+ index_offsets <- c(0, cumsum((num_leaves-1):1))
+
+ # This is the slow part, we compute both vectors as gain would be marginal.
+ sapply(annotated_nodes, function(node) {
+
+ # We skip leaves and the root (if the MRCA for M groups of leaves is at the root
+ # all combinations of leaves -among different groups- have 0 as distance to the root).
+ # For large trees this can spare us of computing a lot of combinations.
+ # Example: In a perfectly balanced binary tree (N/2 leaves at each side of the root),
+ # at the root we'd save (N/2) * (N/2) combinations to update. Worst case scenario is completely
+ # unbalanced tree (N-1,1), we'd save in that case only N-1 combinations.
+
+ # Make sure we are not visiting a leaf or the root.
+ if(length(node$partitions) > 1 && node$root_distance > 0) {
+
+ # Update all combinations for pairs of leaves from different groups.
+ num_groups <- length(node$partitions)
+ for(group_a in 1:(num_groups-1)) {
+ for(group_b in (group_a+1):num_groups) {
+ updateDistancesWithCombinations(length_root_distances, topological_root_distances, node$partitions[[group_a]],
+ node$partitions[[group_b]], index_offsets, node$root_distance, node$edges_to_root)
+ }
+ }
+
+ }
+ })
+
+ if(!return.lambda.function)
+ return(tip.weighting * (lambda * length_root_distances + (1-lambda) * topological_root_distances))
+ else {
+ return(function(l) {
+ if(l<0 || l>1) stop("Pick lambda in [0,1]")
+ return(tip.weighting * (l * length_root_distances + (1-l) * topological_root_distances)) })
+ }
+}
+
+
+
+
+#' Metric function
+#'
+#' Comparison of two trees using the Kendall Colijn metric
+#'
+#' @author Jacob Almagro-Garcia \email{nativecoder@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param tree.a an object of the class \code{phylo}
+#' @param tree.b an object of the class \code{phylo} (with the same tip labels as tree.a)
+#' @param lambda a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.
+#' @param return.lambda.function If true, a function that can be invoked with different lambda values is returned.
+#' This function returns the vector of metric values for the given lambda.
+#' @param emphasise.tips an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.
+#' @param emphasise.weight applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.
+#'
+#' @return The distance between the two trees according to the metric for the given value of lambda, or a function that produces the distance given a value of lambda.
+#'
+#'
+#' @import ape
+#'
+#'
+#' @examples
+#'
+#' ## generate random trees
+#' tree.a <- rtree(6)
+#' tree.b <- rtree(6)
+#' treeDist(tree.a,tree.b) # lambda=0
+#' treeDist(tree.a,tree.b,1) # lambda=1
+#' dist.func <- treeDist(tree.a,tree.b,return.lambda.function=TRUE) # distance as a function of lambda
+#' dist.func(0) # evaluate at lambda=0. Equivalent to treeDist(tree.a,tree.b).
+#' ## We can see how the distance changes when moving from focusing on topology to length:
+#' plot(sapply(seq(0,1,length.out=100), function(x) dist.func(x)), type="l",ylab="",xlab="")
+#'
+#' ## The distance may also change if we emphasise the position of certain tips:
+#' plot(sapply(tree.a$tip.label, function(x) treeDist(tree.a,tree.b,emphasise.tips=x)),
+#' xlab="Tip number",ylab="Distance when vector entries corresponding to tip are doubled")
+#'
+#'
+#' @export
+treeDist <- function(tree.a, tree.b, lambda=0, return.lambda.function=FALSE, emphasise.tips=NULL, emphasise.weight=2) {
+
+ if(length(tree.a$tip.label) != length(tree.b$tip.label)) stop("Trees must have the same number of tips")
+
+ if(setequal(tree.a$tip.label,tree.b$tip.label) == FALSE) stop("Trees must have the same tip label sets")
+
+ metric_a <- treeVec(tree.a, lambda, return.lambda.function, emphasise.tips, emphasise.weight)
+ metric_b <- treeVec(tree.b, lambda, return.lambda.function, emphasise.tips, emphasise.weight)
+ if(!return.lambda.function) {
+ return(sqrt(sum((metric_a - metric_b)^2)))
+ }
+ else {
+ return(function(l) {
+ return(sqrt(sum((metric_a(l) - metric_b(l))^2)))
+ })
+ }
+}
+
+
+#' Metric function for \code{multiPhylo} input
+#'
+#' Comparison of a list of trees using the Kendall Colijn metric. Output is given as a pairwise distance matrix. This is equivalent to the \code{$D} output from \code{treespace} but may be preferable for large datasets, and when principal co-ordinate analysis is not required. It includes an option to save memory at the expense of computation time.
+#'
+#' @author Jacob Almagro-Garcia \email{nativecoder@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param trees an object of the class \code{multiPhylo} containing the trees to be compared
+#' @param lambda a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.
+#' @param return.lambda.function If true, a function that can be invoked with different lambda values is returned.
+#' This function returns the matrix of metric values for the given lambda.
+#' @param save.memory A flag that saves a lot of memory but increases the execution time (not compatible with return.lambda.function=TRUE).
+#' @param emphasise.tips an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.
+#' @param emphasise.weight applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.
+#'
+#' @return The pairwise tree distance matrix or a function that produces the distance matrix given a value for lambda.
+#'
+#'
+#' @import ape
+#' @importFrom fields rdist
+#' @importFrom stats as.dist
+#'
+#'
+#' @examples
+#'
+#' ## generate 10 random trees, each with 6 tips
+#' trees <- rmtree(10,6)
+#'
+#' ## pairwise distance matrix when lambda=0
+#' multiDist(trees)
+#'
+#' ## pairwise distance matrix as a function of lambda:
+#' m <- multiDist(trees, return.lambda.function=TRUE)
+#'
+#' ## evaluate at lambda=0. Equivalent to multiDist(trees).
+#' m0 <- m(0)
+#'
+#' ## save memory by recomputing each tree vector for each pairwise tree comparison (for fixed lambda):
+#' m0.5 <- multiDist(trees,0.5,save.memory=TRUE)
+#'
+#'
+#' @export
+multiDist <- function(trees, lambda=0,
+ return.lambda.function=FALSE, save.memory=FALSE,
+ emphasise.tips=NULL, emphasise.weight=2) {
+
+ if(!inherits(trees, "multiPhylo")) stop("trees should be a multiphylo object")
+ num_trees <- length(trees)
+ if(num_trees<2) {
+ stop("multiDist expects at least two trees")
+ }
+
+ # make name labels well defined
+ if(is.null(names(trees))) names(trees) <- 1:num_trees
+ else if(length(unique(names(trees)))!=num_trees){
+ warning("duplicates detected in tree labels - using generic names")
+ names(trees) <- 1:num_trees
+ }
+ lab <- names(trees)
+
+ # check all trees have same tip labels
+ for (i in 1:num_trees) {
+ if (!setequal(trees[[i]]$tip.label,trees[[1]]$tip.label)) {
+ stop(paste0("Tree ",lab[[i]]," has different tip labels from the first tree."))
+ }
+ }
+
+
+ # Working with numbers (no functions).
+ if(!return.lambda.function) {
+
+ # Here we speed up the computation by storing all vectors (a lot of memory for big trees).
+ if(!save.memory) {
+ # Compute the metric vector for all trees.
+ tree_metrics <- t(sapply(trees, function(tree) {treeVec(tree, lambda, F, emphasise.tips, emphasise.weight)}))
+ distances <- rdist(tree_metrics)
+ }
+
+ # To save memory we recompute the vectors for each tree comparison (way slower but we don't eat a ton of memory).
+ else {
+ distances <- matrix(0.0, num_trees, num_trees)
+
+ sapply(1:(num_trees-1), function(i) {
+ sapply((i+1):num_trees, function(j) {
+ distances[i,j] <<- distances[j,i] <<- treeDist(trees[[i]], trees[[j]], lambda, F, emphasise.tips, emphasise.weight)
+ })
+ })
+ }
+
+ return(as.dist(distances))
+ }
+
+ # Working with functions.
+ else {
+
+ if(save.memory)
+ warning("save.memory=TRUE is incompatible with return.lambda.function=TRUE, setting save.memory=FALSE")
+
+ # Compute the list of metric functions for all trees.
+ tree_metric_functions <- sapply(trees, function(tree) {treeVec(tree, lambda, T, emphasise.tips, emphasise.weight)})
+
+ # Inner function that we'll return, computes the distance matrix given lambda.
+ compute_distance_matrix_function <- function(l) {
+ distances <- matrix(0.0, num_trees, num_trees)
+ sapply(1:(num_trees-1), function(i) {
+ sapply((i+1):num_trees, function(j) {
+ distances[i,j] <<- distances[j,i] <<- sqrt(sum((tree_metric_functions[[i]](l) - tree_metric_functions[[j]](l))^2))
+ })
+ })
+ return(as.dist(distances))
+ }
+ return(compute_distance_matrix_function)
+ }
+}
+
+#' Metric function for comparing a reference \code{phylo} to \code{multiPhylo} input
+#'
+#' Comparison of a single reference tree to a list of trees using the Kendall Colijn metric. Output is given as a vector of distances from the reference tree.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param refTree a tree of class \code{phylo}, the "reference tree".
+#' @param trees an object of the class \code{multiPhylo} containing the trees to be compared to the reference tree
+#' @param lambda a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.
+#' @param return.lambda.function If true, a function that can be invoked with different lambda values is returned.
+#' This function returns the vector of metric values for the given lambda.
+#' @param emphasise.tips an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.
+#' @param emphasise.weight applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.
+#'
+#' @return The vector of distances, where entry i corresponds to the distance between the i'th tree and the reference tree, or a function that produces the vector of distances given a value for lambda.
+#'
+#'
+#' @import ape
+#' @importFrom stats as.dist
+#'
+#'
+#' @examples
+#'
+#' ## generate a single reference tree with 6 tips
+#' refTree <- rtree(6)
+#'
+#' ## generate 10 random trees, each with 6 tips
+#' trees <- rmtree(10,6)
+#'
+#' ## find the distances from each of the 10 random trees to the single reference tree
+#' refTreeDist(refTree,trees)
+#'
+#' @export
+refTreeDist <- function(refTree, trees, lambda=0, return.lambda.function=FALSE,
+ emphasise.tips=NULL, emphasise.weight=2) {
+
+ if(!inherits(refTree, "phylo")) stop("refTree should be a phylo object")
+ if(!inherits(trees, "multiPhylo")) stop("trees should be a multiphylo object")
+ num_trees <- length(trees)
+
+ # make name labels well defined
+ if(is.null(names(trees))) names(trees) <- 1:num_trees
+ else if(length(unique(names(trees)))!=num_trees){
+ warning("duplicates detected in tree labels - using generic names")
+ names(trees) <- 1:num_trees
+ }
+ lab <- names(trees)
+
+ # check all trees have same tip labels
+ for (i in 1:num_trees) {
+ if (!setequal(trees[[i]]$tip.label,refTree$tip.label)) {
+ stop(paste0("Tree ",lab[[i]]," has different tip labels from the reference tree."))
+ }
+ }
+
+ # Working with numbers (no functions).
+ if(!return.lambda.function) {
+ # compute reference tree vector, which will be used repeatedly
+ refVec <- treeVec(refTree, lambda, F, emphasise.tips, emphasise.weight)
+
+ # for each tree, compute its vector and store Euclidean distance from refVec
+ distances <- sapply(trees, function(x) {
+ tmpVec <- treeVec(x, lambda, F, emphasise.tips, emphasise.weight)
+ sqrt(sum((refVec-tmpVec)^2))
+ })
+ return(as.vector(distances))
+ }
+
+ # Working with functions.
+ else {
+ # compute reference tree vector function
+ refVec <- treeVec(refTree, lambda, T, emphasise.tips, emphasise.weight)
+ # Compute the list of metric functions for all trees.
+ treeVecs <- sapply(trees, function(x) treeVec(x, lambda, T, emphasise.tips, emphasise.weight))
+
+ # Inner function that we'll return, computes the distance matrix given lambda.
+ compute_distance_vector_function <- function(l) {
+ sapply(1:num_trees, function(x) sqrt(sum((refVec(l)-treeVecs[[x]](l))^2)))
+ }
+ return(compute_distance_vector_function)
+ }
+}
diff --git a/R/plotGroves.R b/R/plotGroves.R
new file mode 100644
index 0000000..d962b66
--- /dev/null
+++ b/R/plotGroves.R
@@ -0,0 +1,251 @@
+#'
+#' Scatterplot of groups of trees
+#'
+#' This function displays the scatterplot of the Multidimensional
+#' Scaling (MDS) output by treespace, superimposing group information
+#' (derived by \code{\link{findGroves}}) using colors.
+#'
+#' This function relies on \code{\link[adegraphics]{s.class}}
+#' from the \code{adegraphics} package.
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#'
+#' @importFrom adegraphics s.class
+#' @importFrom adegraphics s.label
+#' @importFrom adegraphics s1d.barchart
+#' @importFrom adegraphics insert
+#' @importFrom adegenet funky
+#' @importFrom adegenet bluepal
+#' @importFrom adegenet transp
+#'
+#' @param x a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}
+#' @param groups a factor defining groups of trees
+#' @param xax a number indicating which principal component to be used as 'x' axis
+#' @param yax a number indicating which principal component to be used as 'y' axis
+#' @param type a character string indicating which type of graph to use
+#' @param col.pal a color palette to be used for the groups
+#' @param bg the background color
+#' @param lab.show a logical indicating whether labels should be displayed
+#' @param lab.col a color for the labels
+#' @param lab.cex the size of the labels
+#' @param lab.optim a logical indicating whether label positions should be optimized to avoid overlap; better display but time-consuming for large datasets
+#' @param point.cex the size of the points
+#' @param scree.pal a color palette for the screeplot
+#' @param scree.size a size factor for the screeplot, between 0 and 1
+#' @param scree.posi either a character string or xy coordinates indicating the position of the screeplot.
+#' @param ... further arguments passed to \code{\link{s.class}}
+#'
+#' @return
+#' An \code{adegraphics} object (class: \code{ADEgS})
+#'
+#' @seealso
+#' \code{\link{findGroves}} to find any clusters in the tree landscape
+#' \code{\link[adegraphics]{s.class}}
+#'
+#'
+#' @examples
+#'
+#' \dontrun{
+#' if(require("adegenet") && require("adegraphics")){
+#' ## load data
+#' data(woodmiceTrees)
+#'
+#' ## run findGroves: treespace+clustering
+#' res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+#'
+#' ## basic plot
+#' plotGroves(res)
+#'
+#' ## adding labels
+#' plotGroves(res, lab.show=TRUE)
+#'
+#' ## customizing
+#' plotGroves(res, lab.show=TRUE,
+#' bg="black", lab.col="white", scree.size=.35)
+#'
+#' ## customizing
+#' plotGroves(res, type="ellipse", lab.show=TRUE,
+#' lab.optim=FALSE, scree.size=.35)
+#'
+#' ## example with no group information
+#' plotGroves(res$treespace$pco)
+#'
+#' ## adding labels
+#' plotGroves(res$treespace$pco, lab.show=TRUE, lab.cex=2)
+#'
+#' }
+#' }
+#'
+#' @export
+plotGroves <- function(x, groups=NULL, xax=1, yax=2,
+ type=c("chull","ellipse"), col.pal=funky, bg="white",
+ lab.show=FALSE, lab.col="black", lab.cex=1, lab.optim=TRUE,
+ point.cex=1, scree.pal=NULL, scree.size=.2,
+ scree.posi=c(.02,.02), ...){
+ ## HANDLE ARGUMENTS ##
+ ## checks
+ type <- match.arg(type)
+ if(is.null(scree.pal)) scree.pal <- function(n) rev(bluepal(n))
+
+ ## x is a list returned by findGroves
+ if(is.list(x) && !is.data.frame(x) && !inherits(x,"dudi")){
+ if(is.null(x$treespace)) stop("if x is a list, it should contain a slot $treespace")
+ groups <- x$groups
+ x <- x$treespace$pco
+ }
+
+ ## x is a dudi object
+ if(inherits(x,"dudi")){
+ eig <- x$eig
+ x <- x$li
+ }
+
+ ## groups missing - just s.label
+ if(is.null(groups)) {
+ ## with labels
+ if(lab.show){
+ out <- s.label(x, xax=xax, yax=yax,
+ plabels=list(optim=lab.optim, col=lab.col, cex=lab.cex),
+ ppoints=list(cex=point.cex),
+ pbackground.col=bg,
+ pgrid.text.col=lab.col, plot=FALSE, ...)
+ } else {
+ ## just points
+ out <- s.label(x, xax=xax, yax=yax,
+ plabels=list(optim=FALSE,cex=0),
+ ppoints=list(cex=point.cex, col=lab.col),
+ pbackground.col=bg,
+ pgrid.text.col=lab.col, plot=FALSE, ...)
+ }
+ } else {
+ ## if groups are provided
+ if(!is.factor(groups)) groups <- factor(groups)
+ n.lev <- length(levels(groups))
+
+
+ ## MAKE GRAPH ##
+ ## base scatterplot
+ if(type=="chull"){
+ out <- s.class(x, xax=xax, yax=yax, fac=groups, col=col.pal(n.lev),
+ ellipseSize=0, chullSize=1,
+ pbackground.col=bg,
+ ppoints.cex=point.cex,
+ pgrid.text.col=lab.col, plot=FALSE, ...)
+ }
+ if(type=="ellipse"){
+ out <- s.class(x, xax=xax, yax=yax, fac=groups, col=col.pal(n.lev),
+ ellipseSize=1,
+ pbackground.col=bg,
+ ppoints.cex=point.cex,
+ pgrid.text.col=lab.col, plot=FALSE, ...)
+ }
+
+ ## add labels
+ if(lab.show){
+ out <- out + s.label(x, plabel.optim=lab.optim, plabel.col=lab.col,
+ ppoints.cex=0, plabels.cex=lab.cex)
+ }
+ }
+ ## add inset
+ if(!is.null(scree.posi[1]) && !is.na(scree.posi[1]) && scree.posi[1]!="none"){
+ screeplot <- s1d.barchart(c(0,eig), p1d.horizontal=FALSE, ppolygons.col=scree.pal(length(eig)+1),
+ pbackground=list(col=transp("white"), box=TRUE),
+ layout.width=list(left.padding=2),
+ pgrid.draw=FALSE, plot=FALSE)
+ out <- insert(screeplot, out, posi=scree.posi, ratio=scree.size, plot=FALSE)
+
+ }
+
+
+ ## RETURN ##
+ return(out)
+} # end plotGroves
+
+
+
+
+
+
+######################
+### ScatterD3 version
+######################
+
+#'
+#' Scatterplot of groups of trees using \code{scatterD3}
+#'
+#' This function displays the scatterplot of the Multidimensional
+#' Scaling (MDS) output by treespace, superimposing group information
+#' (derived by \code{\link{findGroves}}) using colors.
+#' \code{scatterD3} enables interactive plotting based on d3.js, including zooming, panning and fading effects in the legend.
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#'
+#' @import scatterD3
+#' @importFrom adegenet funky
+#' @importFrom adegenet bluepal
+#' @importFrom adegenet transp
+#'
+#' @param x a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}
+#' @param groups a factor defining groups of trees. If x is a list returned by \code{\link{findGroves}} these will be detected automatically.
+#' @param xax a number indicating which principal component to be used as 'x' axis
+#' @param yax a number indicating which principal component to be used as 'y' axis
+#' @param treeNames if a list of tree names or labels are given, these will be plotted alongside the points. Their size can be altered using \code{labels_size} - see \code{?scatterD3} for more information.
+#' @param xlab the label for the 'x' axis. Defaults to use the value of 'xax'
+#' @param ylab the label for the 'y' axis. Defaults to use the value of 'yax'
+#' @param symbol_var a factor by which to vary the symbols in the plot
+#' @param ... further arguments passed to \code{\link{scatterD3}}
+#'
+#' @return
+#' A \code{scatterD3} plot
+#'
+#'
+#' @seealso
+#' \code{\link{findGroves}} to find any clusters in the tree landscape
+#'
+#'
+#' @examples
+#'
+#' \dontrun{
+#' if(require("adegenet") && require("scatterD3")){
+#' ## load data
+#' data(woodmiceTrees)
+#'
+#' ## run findGroves: treespace+clustering
+#' res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+#'
+#' ## basic plot
+#' plotGrovesD3(res)
+#'
+#' ## adding tree labels
+#' plotGrovesD3(res, treeNames=1:201)
+#'
+#' ## customizing: vary the colour and the symbol by group
+#' plotGrovesD3(res, symbol_var=res$groups)
+#'
+#' ## example with no group information
+#' plotGrovesD3(res$treespace$pco)
+#' }
+#' }
+#'
+#' @export
+plotGrovesD3 <- function(x, groups=NULL, xax=1, yax=2, treeNames=NULL, symbol_var=NULL,
+ xlab=paste0("Axis ",xax), ylab=paste0("Axis ",yax), ...){
+ ## HANDLE ARGUMENTS ##
+ ## checks
+
+ ## x is a list returned by findGroves
+ if(is.list(x) && !is.data.frame(x) && !inherits(x,"dudi")){
+ if(is.null(x$treespace)) stop("if x is a list, it should contain a slot $treespace")
+ groups <- x$groups
+ x <- x$treespace$pco$li
+ }
+
+ ## x is a dudi object
+ if(inherits(x,"dudi")){
+ eig <- x$eig
+ x <- x$li
+ }
+
+ scatterD3(x[,xax],x[,yax], lab=treeNames, col_var=groups, symbol_var=symbol_var,
+ xlab=xlab, ylab=ylab, ...)
+} # end plotGrovesD3
diff --git a/R/plotTreeDiff.R b/R/plotTreeDiff.R
new file mode 100644
index 0000000..cc828f7
--- /dev/null
+++ b/R/plotTreeDiff.R
@@ -0,0 +1,182 @@
+#' Find tip position differences
+#'
+#' Find the topologicial differences between two trees with the same tip labels. The function returns a data frame of the tips and the number of differences in their ancestry between the two trees.
+#' Called by \code{\link{plotTreeDiff}}, which highlights the differing tips in a plot of the two trees.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @import ape
+#' @importFrom combinat combn2
+#'
+#' @param tr1 an object of the class \code{phylo}: the first tree to compare.
+#' @param tr2 an object of the class \code{phylo}: the second tree to compare.
+#' @param vec1 an optional input, the result of \code{treeVec(tr1, lambda=0)}, to speed up the computation.
+#' @param vec2 an optional input, the result of \code{treeVec(tr2, lambda=0)}, to speed up the computation.
+#'
+#' @return
+#' A data frame of the tree tips and the number of ancestral differences between them in the two trees, in order of increasing difference.
+#' A tip is said to have zero difference if each of its ancestral nodes admits the same tip partition in the two trees.
+#'
+#' @seealso \code{\link{medTree}} \code{\link{plotTreeDiff}}
+#'
+#' @examples
+#' ## simple example on trees with five tips:
+#' tr1 <- read.tree(text="((A:1,B:1):1,((C:1,D:1):1,E:1):1):1;")
+#' tr2 <- read.tree(text="((A:1,B:1):1,(C:1,(D:1,E:1):1):1):1;")
+#' tipDiff(tr1,tr2)
+#'
+#' ## example on larger woodmice trees
+#' data(woodmiceTrees)
+#' tipDiff(woodmiceTrees[[1]],woodmiceTrees[[2]])
+#'
+#' @export
+tipDiff <- function(tr1,tr2,vec1=NULL,vec2=NULL) {
+
+ l <- length(tr1$tip.label)
+ lchoose2 <- l*(l-1)/2
+ if( l != length(tr2$tip.label)) stop("Trees must have the same number of tips")
+
+ if(setequal(tr1$tip.label,tr2$tip.label) == FALSE) stop("Trees must have the same tip label sets")
+
+ # get vec1
+ if (is.null(vec1)) {
+ vec1 <- treeVec(tr1) # emphasise.tips, emphasise.weight)
+ }
+ if (is.null(vec2)) {
+ vec2 <- treeVec(tr2) # emphasise.tips, emphasise.weight)
+ }
+
+ # trim pendant edge entries from vectors
+ vec1 <- vec1[1:lchoose2] # emphasise.tips, emphasise.weight)
+ vec2 <- vec2[1:lchoose2]
+
+ # find the positions where the vectors are different
+ vecDiff <- (vec1!=vec2)
+
+ # combine the tip labels (in order) and whether the vectors are different
+ treedf <- as.data.frame(cbind(combn2(tr1$tip.label[order(tr1$tip.label)]),vecDiff))
+
+ # list the tips which appear in "TRUE" rows
+ allTipDiffs <- c(as.character(treedf[,1][vecDiff]),as.character(treedf[,2][vecDiff]))
+
+ # find the number of times each tip appears
+ tipSignificance <- sapply(tr1$tip.label, function(x)
+ length(which(allTipDiffs==x)))
+
+ # prepare output as data frame of tips and their differences
+ tipDiff <- as.data.frame(cbind(names(tipSignificance[order(tipSignificance)]),tipSignificance[order(tipSignificance)]), stringsAsFactors = FALSE)
+ class(tipDiff[,2]) <- "numeric"
+ rownames(tipDiff) <- NULL
+ colnames(tipDiff) <- c("Tip","No. of differences")
+
+ return(tipDiff)
+}
+
+
+
+
+#' Plot tree differences
+#'
+#' Highlight the topologicial differences between two trees, plotted side by side.
+#' This function is useful for comparing representative "median" trees - see \code{\link{medTree}}.
+#' It relies on the function \code{\link{tipDiff}}.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @import ape
+#' @importFrom adegenet lightseasun
+#' @importFrom adegenet num2col
+#' @importFrom grDevices colorRampPalette
+#' @importFrom graphics layout
+#'
+#' @param tr1 an object of the class \code{phylo}: the first tree to plot.
+#' @param tr2 an object of the class \code{phylo}: the second tree to plot.
+#' @param tipDiff an optional input, the result of \code{\link{tipDiff}}. Supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.
+#' @param vec1 an optional input, the result of \code{treeVec(tr1, lambda=0)}. This argument is ignored if \code{tipDiff} is supplied; otherwise supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.
+#' @param vec2 an optional input, the result of \code{treeVec(tr2, lambda=0)}. This argument is ignored if \code{tipDiff} is supplied; otherwise supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.
+#' @param baseCol the colour used for tips with identical ancestry in the two trees. Defaults to "grey".
+#' @param colourMethod the method to use for colouring. Default is "ramp", corresponding to the original implementation, where the function \code{colorRampPalette} is used to create a palette which ranges from \code{col1} to \code{col2}. For large trees this can be hard to interpret, and method \code{palette} may be preferred, which permits the selection of a palette to use in \code{adegenet}'s function \code{num2col}.
+#' @param col1 the first colour used to define the colour spectrum for tips with differences. This colour will be used for tips with minor differences. Defaults to "peachpuff". Ignored if \code{colourMethod="palette"}.
+#' @param col2 the second colour used to define the colour spectrum for tips with differences. This colour will be used for tips with major differences. Defaults to "red2". Ignored if \code{colourMethod="palette"}.
+#' @param palette the colour palette to be used if \code{colourMethod="palette"}. For a list of available palettes see \code{?num2col}.
+#' @param ... further arguments passed to \code{\link{plot.phylo}}
+#'
+#' @return
+#' A plot of the two trees side by side. Tips are coloured in the following way:
+#' \itemize{
+#' \item if each ancestor of a tip in tree 1 occurs in tree 2 with the same partition of tip descendants, then the tip is coloured grey (or supplied "baseCol")
+#' \item if not, the tip gets coloured pale orange to red on a scale according to how many differences there are amongst its most recent common ancestors with other tips. The colour spectrum can be changed according to preference.
+#' }
+#'
+#' @seealso \code{\link{medTree}}, \code{\link{tipDiff}}
+#'
+#' @examples
+#' ## simple example on trees with five tips:
+#' tr1 <- read.tree(text="((A:1,B:1):1,((C:1,D:1):1,E:1):1):1;")
+#' tr2 <- read.tree(text="((A:1,B:1):1,(C:1,(D:1,E:1):1):1):1;")
+#' plotTreeDiff(tr1,tr2)
+#'
+#' ## example on larger woodmice trees
+#' data(woodmiceTrees)
+#' # find the tip differences in advance, to avoid recalculating with each plot
+#' wmTipDiff <- tipDiff(woodmiceTrees[[1]],woodmiceTrees[[2]])
+#' plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff)
+#' ## change aesthetics:
+#' plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff,
+#' baseCol="grey2", col1="cyan", col2="navy",
+#' edge.width=2, type="radial", cex=0.5, font=2)
+#' ## use colour palette from adegenet:
+#' plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff,
+#' baseCol="black", colourMethod="palette",
+#' edge.width=2, type="cladogram", cex=0.5, font=2)
+#'
+#' @export
+plotTreeDiff <- function(tr1,tr2,tipDiff=NULL,vec1=NULL,vec2=NULL,baseCol="grey",col1="peachpuff",col2="red2",colourMethod="ramp",palette=lightseasun,...) {
+
+ l <- length(tr1$tip.label)
+
+ if (is.null(tipDiff)){
+ # call tipDiff
+ tipDiff <- tipDiff(tr1,tr2,vec1,vec2)
+ }
+
+ # find the number of times each tip appears, in the order that the tip labels are read
+ tipSignificance1 <- sapply(tr1$tip.label, function(x)
+ tipDiff[which(tipDiff[,1]==x),2])
+ tipSignificance2 <- sapply(tr2$tip.label, function(x)
+ tipDiff[which(tipDiff[,1]==x),2])
+
+ if (colourMethod=="ramp") {
+ colfunc <- colorRampPalette(c(col1,col2))
+
+ if (min(tipDiff[,2])==0) { # make sure tips with no differences are coloured baseCol
+ tipSignificance1 <- tipSignificance1 + 1
+ tipSignificance2 <- tipSignificance2 + 1
+ if (max(tipDiff[,2])==0) {numCols <- 0}
+ else {numCols <- max(tipDiff[,2]) - min(tipDiff[,2][which(tipDiff[,2]!=0)]) + 1}
+ pal <- c(baseCol,colfunc(numCols))
+ }
+ else {
+ numCols <- max(tipDiff[,2]) - min(tipDiff[,2]) + 1
+ pal <- colfunc(numCols)
+ }
+
+ tipCols1 <- pal[as.factor(tipSignificance1)]
+ tipCols2 <- pal[as.factor(tipSignificance2)]
+ }
+
+ else {
+ tipCols1 <- num2col(tipSignificance1, col.pal=palette)
+ tipCols2 <- num2col(tipSignificance2, col.pal=palette)
+ if (min(tipDiff[,2])==0) { # make sure tips with no differences are coloured baseCol
+ tipCols1[which(tipSignificance1==0)] <- baseCol
+ tipCols2[which(tipSignificance2==0)] <- baseCol
+ }
+ }
+
+ # plot
+ layout(matrix(1:2, 1, 2))
+ plot.phylo(tr1, tip.color=tipCols1, no.margin=TRUE, ...)
+ plot.phylo(tr2, tip.color=tipCols2, no.margin=TRUE, ...)
+
+}
\ No newline at end of file
diff --git a/R/servers.R b/R/servers.R
new file mode 100644
index 0000000..01d6a11
--- /dev/null
+++ b/R/servers.R
@@ -0,0 +1,74 @@
+#'
+#' Web-based tree explorer
+#'
+#' This function opens up an application in a web browser for an interactive exploration of the diversity in a set of trees.
+#' For further details please see the "help" tab within the application.
+#'
+#' @seealso For convenience, \code{treespaceServer} is also available as a separate web app which can be used from any browser (it is not necessary to have \R installed): {\url{http://shiny.imperial-stats-experimental.co.uk/users/mlkendal/treespace/}}
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @import ape
+
+#' @import scatterD3
+#' @import shiny
+#' @importFrom ade4 dudi.pco
+#' @importFrom adegraphics s1d.barchart
+#' @importFrom adegraphics s.class
+#' @importFrom adegraphics s.label
+#' @importFrom adephylo distTips
+#' @importFrom distory dist.multiPhylo
+#' @importFrom fields rdist
+#' @importFrom htmlwidgets saveWidget
+#' @importFrom MASS Shepard
+#' @importFrom phangorn Children
+#' @importFrom phangorn Descendants
+#' @importFrom RLumShiny jscolorInput
+#' @importFrom shinyBS bsTooltip
+#' @importFrom utils packageDescription
+#'
+#'
+#'
+#' @export
+treespaceServer <- function(){
+ ## RUN APP
+ runApp(system.file("shiny",package="treespace"))
+ return(invisible())
+}
+
+
+
+
+
+#'
+#' Auxiliary functions
+#'
+#' These functions are not supposed to be used by the user.
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#'
+#'
+#' @importFrom adegenet .readExt
+#'
+#' @export
+.render.server.info <- function(){
+ renderPrint(
+ {
+ cat("\n== R version ==\n")
+ print(R.version)
+
+ cat("\n== Date ==\n")
+ print(date())
+
+ cat("\n== treespace version ==\n")
+ print(packageDescription("treespace", fields=c("Package", "Version", "Date", "Built")))
+
+ cat("\n== shiny version ==\n")
+ print(packageDescription("shiny", fields=c("Package", "Version", "Date", "Built")))
+
+ cat("\n== attached packages ==\n")
+ print(search())
+ }
+ ) # end renderPrint
+} # end .render.server.info
diff --git a/R/transmissionTrees.R b/R/transmissionTrees.R
new file mode 100644
index 0000000..bbfd309
--- /dev/null
+++ b/R/transmissionTrees.R
@@ -0,0 +1,218 @@
+#' Find MRCIs
+#'
+#' Function to find the most recent common infector (MRCI) matrix from "who infected whom" information.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param wiw a two-column matrix where the first column represents the infectors and the infectees; each row corresponds to a transmission event from an infector to an infectee.
+#'
+#' @return Returns three objects:
+#' \itemize{
+#' \item \code{sourceCase}: the number of the node which is the source case, i.e. the common infector of all cases (outputs a warning if there is more than one source case).
+#' \item \code{mrcis}: a matrix where, for each pair of individuals i and j, the entry (i,j) is the node number of their MRCI. Note that if i infected j then this entry is i itself.
+#' \item \code{mrciDepths}: a matrix where, for each pair of individuals i and j, the entry (i,j) is the depth of their MRCI, defined as the number of edges from the source case. The source case has depth zero, its direct infectees have depth 1, and so on.
+#' }
+#'
+#' @importFrom compiler cmpfun
+#' @importFrom combinat combn2
+#'
+#' @examples
+#'
+#' ## a simple who infected whom matrix:
+#' tree1 <- cbind(Infector=1:5,Infectee=2:6)
+#' findMRCIs(tree1)
+#'
+#'
+#' @export
+findMRCIs <- compiler::cmpfun(function(wiw) {
+ # expect wiw to be a "who infected whom" matrix: column 1 is infectors, column 2 infectees
+ if (class(wiw) != "matrix") stop("The who infected whom information supplied should be of class matrix.")
+
+ initial <- min(wiw) # the number of the first case
+ # if the first case is "0" we'll get problems - add one to everything
+ if (initial==0) {
+ wiw <- wiw + 1
+ initial <- min(wiw)
+ }
+
+ l <- max(wiw) # largest node number (note, not necessarily the "last" case)
+
+ # make a reference list where entry i gives all the direct descendant(s) of case i
+ DirectDesc <- lapply(initial:l, function(x) {
+ wiw[which(wiw[,1]==x),2] # direct infectee(s) of x, if any
+ })
+
+ numDDs <- sapply(DirectDesc, length)
+
+ AllDesc <- lapply(initial:l, function(x) {
+ # for each node x:
+ DDs <- DirectDesc[[x]] # find direct descendants
+ tmpNumDDs <- length(DDs) # store the number of them
+ allDs <- rep(NA, length(initial:l)) # start a vector of all descendants of x, including x itself
+ allDs[[1]] <- x
+
+ while(tmpNumDDs!=0){
+ allDs[which(is.na(allDs))[1:tmpNumDDs]] <- DDs
+ DDs <- do.call(c, DirectDesc[DDs]) # now find direct descendants of these, as a vector...
+ tmpNumDDs <- length(DDs)
+ }
+
+ return(allDs[!is.na(allDs)])
+ })
+
+ M <- matrix(0, nrow=l, ncol=l) # initialise matrix
+
+ # traverse nodes from initial case, down the "tree"
+ for (tmp in initial:l){
+
+ # tmp is the MRCA of all its descendants with itself
+ # (if tmp has no descendants, this syntax is still ok)
+ for (i in AllDesc[[tmp]]) {
+ M[tmp,i] <- M[i,tmp] <- tmp
+ }
+
+ # get the direct cases infected by tmp. If there are two or more, then tmp is the MRCA of all pairs of cases descending from different DDs
+ tmpDDs <- DirectDesc[[tmp]]
+ numTmpDDs <- length(tmpDDs)
+
+ if (numTmpDDs>1) { # then tmp is the MRCI of descendant one and descendant two, and of each pair comprised of a descendant from one and a descendant from two
+ pairs <- combn2(tmpDDs)
+ for (j in 1:length(pairs[,1])) {
+ M[AllDesc[[pairs[j,1]]],AllDesc[[pairs[j,2]]]] <- M[AllDesc[[pairs[j,2]]],AllDesc[[pairs[j,1]]]] <- tmp
+ }
+ } # end if loop
+ }# end for tmp loop
+
+ diag(M) <- initial:l # we define the diagonal elements of M to be the nodes themselves
+
+ # note: if there are multiple source cases then there will still be zero entries in the matrix, which haven't been overwritten since the initialisation step
+ # if there is a single source case, it's the one whose entry in AllDescs is initial:l
+ if (min(M)==0) {
+ warning("No single source case; returning source of longest transmission chain")
+ transChainLengths <- sapply(AllDesc, function(x) length(x))
+ sourceOfLongestChain <- which(transChainLengths==max(transChainLengths))
+ sourceCase <- sourceOfLongestChain
+ }
+ else {
+ sourceCase <- NA
+ count <- 1
+ while(is.na(sourceCase)){
+ isSource <- setequal(AllDesc[[count]],initial:l)
+ if (isSource) {sourceCase <- count}
+ count <- count + 1
+ }
+ }
+
+ # finally, we want to know the "depth" of each case (distance from source case)
+ # and we want a version of M where the entries are the depths of the mrcis, rather than the IDs of the mrcis
+
+ depths <- rep(NA, l)
+ count <- 0
+ depths[[sourceCase]] <- count
+ SCdescs <- unlist(DirectDesc[[sourceCase]], FALSE, FALSE)
+ while(length(SCdescs)!=0){
+ count <- count + 1
+ depths[SCdescs] <- count
+ SCdescs <- unlist(DirectDesc[SCdescs], FALSE, FALSE)
+ }
+
+ D <- matrix(ncol=l, nrow=l, depths[M])
+
+ return(list(sourceCase=sourceCase,mrcis=M,mrciDepths=D))
+})
+
+#' Transmission tree distance
+#'
+#' Function to find the distance between transmission trees by comparing their MRCI depth matrices; to be precise, by finding the Euclidean distance between the tree vectors, restricted to their sampled node entries.
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param matList a list of matrices, each of which is the output of \code{findMRCIs$mrciDepths}
+#' @param sampled a vector of node IDs which corresponds to those nodes which are sampled cases. Default is to treat all nodes as sampled cases.
+#'
+#' @return Returns a distance matrix, where entry (i,j) is the transmission tree distance between matrices i and j in \code{matList}
+#'
+#' @importFrom compiler cmpfun
+#' @importFrom fields rdist
+#'
+#' @examples
+#' # create some simple "who infected whom" scenarios:
+#' tree1 <- cbind(Infector=1:5,Infectee=2:6)
+#' tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+#' tree3 <- cbind(Infector=c(2,2,3,4,5),Infectee=c(1,3,4,5,6))
+#' # create list of the MRCI depth matrices:
+#' matList <- lapply(list(tree1,tree2,tree3), function(x) findMRCIs(x)$mrciDepths)
+#'
+#' # transmission tree distance, assuming all cases are sampled:
+#' wiwTreeDist(matList)
+#' # transmission tree distance when cases 1, 2 and 4 are sampled:
+#' wiwTreeDist(matList, sampled=c(1,2,4))
+#'
+#' @export
+wiwTreeDist <- compiler::cmpfun(function(matList, sampled=NULL) {
+ if (is.null(sampled)) {sampled <- 1:length(matList[[1]][1,])}
+
+ matVecs <- lapply(matList, function(x) as.vector(x[sampled,sampled]))
+ df <- t(data.frame(matVecs))
+
+ ## get pairwise Euclidean distances ##
+ D <- as.dist(rdist(df))
+
+ return(D)
+})
+
+#' Median transmission tree
+#'
+#' Function to find the median of a list of transmission scenarios
+#'
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @param matList a list of matrices, each of which is the output of \code{findMRCIs$mrciDepths}
+#' @param sampled a vector of node IDs which corresponds to those nodes which are sampled cases
+#' @param weights optional vector of weights to correspond to the entries of matList
+#'
+#' @return Returns three objects:
+#' \itemize{
+#' \item \code{centre}: the mean of the matList entries, restricted to the sampled cases
+#' \item \code{distances}: for each entry of matList, its distance from \code{centre}
+#' \item \code{mindist}: the minimum of \code{distances}
+#' \item \code{median}: the number of the median entry of matList, i.e. the one(s) which achieve the \code{mindist} from the \code{centre}.
+#' }
+#'
+#' @importFrom compiler cmpfun
+#' @importFrom combinat combn2
+#'
+#' @examples
+#' # create some simple "who infected whom" scenarios:
+#' tree1 <- cbind(Infector=1:5,Infectee=2:6)
+#' tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+#' tree3 <- cbind(Infector=c(2,2,3,4,5),Infectee=c(1,3,4,5,6))
+#' # create list of the MRCI depth matrices:
+#' matList <- lapply(list(tree1,tree2,tree3), function(x) findMRCIs(x)$mrciDepths)
+#'
+#' # median tree, assuming all cases are sampled:
+#' wiwMedTree(matList)
+#' # median tree when cases 1, 2 and 4 are sampled:
+#' wiwMedTree(matList, sampled=c(1,2,4))
+#'
+#' @export
+wiwMedTree <- compiler::cmpfun(function(matList, sampled=NULL, weights=NULL){
+ l <- length(matList)
+
+ if (is.null(sampled)) {sampled <- 1:length(matList[[1]][1,])}
+ if (is.null(weights)) {weights <- rep(1,l)}
+
+ matVecs <- t(sapply(matList, function(x) as.vector(x[sampled,sampled])))
+
+ centre <- weights %*% matVecs/l
+
+ ## Distances to the centre.
+ distances <- apply(matVecs, 1, function(m){sqrt(sum((m-centre)^2))})
+
+ ## Get the indices for the median wiw(s).
+ min_distance <- min(distances)
+ median_wiw <- which(min_distance == distances)
+
+ return(list(centre=centre, distances=distances, mindist=min_distance, median=median_wiw))
+})
+
diff --git a/R/treespace.R b/R/treespace.R
new file mode 100644
index 0000000..3649a23
--- /dev/null
+++ b/R/treespace.R
@@ -0,0 +1,150 @@
+#'
+#' Phylogenetic tree exploration
+#'
+#' Compares phylogenetic trees and maps them into a small number of dimensions for easy visualisation and identification of clusters.
+#'
+#' @param x an object of the class multiPhylo
+#' @param method the method for summarising the tree as a vector.
+#' Choose from:
+#' \code{treeVec} (default) the Kendall Colijn metric vector
+#' \code{BHV} the Billera, Holmes Vogtmann metric using \code{dist.multiPhylo} from package \code{distory}
+#' \code{KF} the Kuhner Felsenstein metric (branch score distance) using \code{KF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+#' \code{RF} the Robinson Foulds metric using \code{RF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
+#' \code{wRF} the weighted Robinson Foulds metric using \code{wRF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
+#' \code{nNodes} the Steel & Penny tip-tip path difference metric, (topological, ignoring branch lengths), using \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+#' \code{patristic} the Steel & Penny tip-tip path difference metric, using branch lengths, calling \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+#' others inherited from \code{distTips} in \code{adephylo}:
+#' \itemize{
+#' \item \code{Abouheif}: performs Abouheif's test. See Pavoine et al. (2008) and \code{adephylo}.
+#' \item \code{sumDD}: sum of direct descendants of all nodes on the path, related to Abouheif's test. See \code{adephylo}.
+#' }
+#' @param nf the number of principal components to retain
+#' @param return.tree.vectors option to also return the tree vectors. Note that this can use a lot of memory so defaults to \code{FALSE}.
+#' @param ... further arguments to be passed to \code{method}.
+#'
+#' @author Thibaut Jombart \email{thibautjombart@@gmail.com}
+#' @author Michelle Kendall \email{michelle.louise.kendall@@gmail.com}
+#'
+#' @import ape
+#' @importFrom ade4 dudi.pco cailliez
+#' @importFrom adephylo distTips
+#' @importFrom distory dist.multiPhylo
+#' @importFrom fields rdist
+#' @importFrom phangorn KF.dist
+#' @importFrom phangorn path.dist
+#' @importFrom phangorn RF.dist
+#' @importFrom phangorn wRF.dist
+#'
+#' @examples
+#'
+#' ## generate list of trees
+#' x <- rmtree(10, 20)
+#' names(x) <- paste("tree", 1:10, sep = "")
+#'
+#' ## use treespace
+#' res <- treespace(x, nf=3)
+#' table.paint(as.matrix(res$D))
+#' scatter(res$pco)
+#'
+#' data(woodmiceTrees)
+#' woodmiceDists <- treespace(woodmiceTrees,nf=3)
+#' plot(woodmiceDists$pco$li[,1],woodmiceDists$pco$li[,2])
+#' woodmicedf <- woodmiceDists$pco$li
+#' if(require(ggplot2)){
+#' woodmiceplot <- ggplot(woodmicedf, aes(x=A1, y=A2)) # create plot
+#' woodmiceplot + geom_density2d(colour="gray80") + # contour lines
+#' geom_point(size=6, shape=1, colour="gray50") + # grey edges
+#' geom_point(size=6, alpha=0.2, colour="navy") + # transparent blue points
+#' xlab("") + ylab("") + theme_bw(base_family="") # remove axis labels and grey background
+#' }
+#'
+#' \dontrun{
+#' if(require(rgl)){
+#' plot3d(woodmicedf[,1], woodmicedf[,2], woodmicedf[,3], type="s", size=1.5,
+#' col="navy", alpha=0.5, xlab="", ylab="", zlab="")
+#' }
+#' }
+#'
+#'
+#' @export
+treespace <- function(x, method="treeVec", nf=NULL, return.tree.vectors=FALSE, ...){
+ ## CHECKS ##
+ if(!inherits(x, "multiPhylo")) stop("x should be a multiphylo object")
+ num_trees <- length(x) # number of trees
+ ## fix potential bug with input of two trees
+ if(num_trees<3) {
+ stop("treespace expects at least three trees. The function treeDist is suitable for comparing two trees.")
+ }
+
+ # check for user supplying invalid options (these gave unhelpful error messages before)
+ dots <- list(...)
+ if(!is.null(dots$return.lambda.function)) stop("return.lambda.function is not compatible with treespace. Consider using multiDist instead.")
+ if(!is.null(dots$save.memory)) stop("save.memory is not compatible with treespace. Consider using multiDist instead.")
+
+ # make name labels well defined
+ if(is.null(names(x))) names(x) <- 1:num_trees
+ else if(length(unique(names(x)))!=num_trees){
+ warning("duplicates detected in tree labels - using generic names")
+ names(x) <- 1:num_trees
+ }
+ lab <- names(x)
+
+ # check all trees have same tip labels
+ for (i in 1:num_trees) {
+ if (!setequal(x[[i]]$tip.label,x[[1]]$tip.label)) {
+ stop(paste0("Tree ",lab[[i]]," has different tip labels from the first tree."))
+ }
+ }
+
+ ## GET DISTANCES BETWEEN TREES, according to method ##
+ ## get data.frame of all summary vectors ##
+ if (method=="treeVec") {
+ df <- t(data.frame(lapply(x, function(e) as.vector(treeVec(e, ...)))))
+ ## get pairwise Euclidean distances ##
+ D <- as.dist(rdist(df))
+ }
+ else if(method %in% c("Abouheif","sumDD")){
+ df <- t(data.frame(lapply(x, function(e) as.vector(adephylo::distTips(e,method=method,...)))))
+ ## get pairwise Euclidean distances ##
+ D <- as.dist(rdist(df))
+ }
+ else if(method=="patristic"){
+ D <- path.dist(x, use.weight=TRUE)
+ }
+ else if(method=="nNodes"){
+ D <- path.dist(x, use.weight=FALSE)
+ }
+ else if(method=="RF"){
+ D <- RF.dist(x)
+ ## make the distance Euclidean
+ D <- ade4::cailliez(D, print=FALSE)
+ }
+ else if(method=="wRF"){
+ names(x) <- NULL # temporary fix to avoid wRF error
+ D <- wRF.dist(x)
+ }
+ else if(method=="KF"){
+ D <- KF.dist(x)
+ }
+ else if(method=="BHV"){
+ D <- dist.multiPhylo(x)
+ ## make the distance Euclidean
+ D <- ade4::cailliez(D, print=FALSE)
+ }
+
+ ## restore labels
+ attr(D,"Labels") <- lab
+
+ ## perform PCoA/MDS ##
+ pco <- dudi.pco(D, scannf=is.null(nf), nf=nf)
+
+
+ ## BUILD RESULT AND RETURN ##
+ if (return.tree.vectors==TRUE) {
+ out <- list(D=D, pco=pco, vectors=df)
+ }
+ else {
+ out <- list(D=D, pco=pco)
+ }
+ return(out)
+} # end treespace
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..aa5dacb
--- /dev/null
+++ b/README.md
@@ -0,0 +1,158 @@
+[](https://travis-ci.org/thibautjombart/treespace)
+[](https://ci.appveyor.com/project/thibautjombart/treespace/branch/master)
+[](https://cran.r-project.org/package=treespace)
+[](https://cran.r-project.org/package=treespace)
+
+
+
+
+*treespace*: exploration of landscapes of phylogenetic trees
+============================================================
+
+*treespace* implements new methods for the exploration and a nalysis of
+distributions of phylogenetic trees for a given set of taxa.
+
+
+Installing *treespace*
+-------------
+To install the development version from github:
+
+```r
+library(devtools)
+install_github("thibautjombart/treespace")
+```
+
+The stable version can be installed from CRAN using:
+
+```r
+install.packages("treespace")
+```
+
+Then, to load the package, use:
+
+```r
+library("treespace")
+```
+
+```
+## Loading required package: ape
+```
+
+```
+## Loading required package: ade4
+```
+
+```
+## Creating a generic function for 'toJSON' from package 'jsonlite' in package 'googleVis'
+```
+
+
+Content overview
+----------------
+
+The main functions implemented in *treespace* are:
+
+* __`treespace`__: explore landscapes of phylogenetic trees
+
+* __`treespaceServer`__: open up an application in a web browser for an
+ interactive exploration of the diversity in a set of trees
+
+* __`findGroves`__: identify clusters of similar trees
+
+* __`plotGroves`__: scatterplot of groups of trees, and __`plotGrovesD3`__ which
+ enables interactive plotting based on d3.js
+
+* __`medTree`__: find geometric median tree(s) to summarise a group of trees
+
+
+Other functions are central to the computations of distances between trees:
+
+* __`treeVec`__: characterise a tree by a vector
+
+* __`treeDist`__: find the distance between two tree vectors
+
+* __`multiDist`__: find the pairwise distances of a list of trees
+
+* __`refTreeDist`__: find the distances of a list of trees from a reference tree
+
+* __`tipDiff`__: for a pair of trees, list the tips with differing ancestry
+
+* __`plotTreeDiff`__: plot a pair of trees, highlighting the tips with differing
+ ancestry
+
+
+Distributed datasets include:
+
+* __`woodmiceTrees`__: illustrative set of 201 trees built using the
+ neighbour-joining and bootstrapping example from the *woodmice* dataset in the
+ *ape* documentation.
+
+* __`DengueTrees`__: 500 trees sampled from a BEAST posterior set of trees from
+ (Drummond and Rambaut, 2007)
+
+* __`DengueSeqs`__: 17 dengue virus serotype 4 sequences from (Lanciotti *et
+ al.*, 1997), from which the `DengueTrees` were inferred.
+
+* __`DengueBEASTMCC`__: the maximum clade credibility (MCC) tree from the
+ `DengueTrees`.
+
+
+
+
+<br>
+
+Documentation
+-------------
+
+*treespace* is fully documented on a [dedicated
+ website](https://thibautjombart.github.io/treespace/).
+
+It also comes with the following vignettes:
+
+-
+ [*introduction*](https://thibautjombart.github.io/treespace/articles/introduction.html):
+ general introduction using a worked example.
+
+- [*Dengue
+ example*](https://thibautjombart.github.io/treespace/articles/DengueVignette.html):
+ worked example using a Dengue dataset, used in the *treespace* publication.
+
+- [*transmission
+ trees*](https://thibautjombart.github.io/treespace/articles/TransmissionTreesVignette.html):
+ worked example using transmission trees.
+
+
+
+
+Contributing / asking a question
+--------------------------------
+Contributions are welcome via **pull requests**.
+
+Please note that this project is released with a [Contributor Code of
+Conduct](CONDUCT.md). By participating in this project you agree to abide by its
+terms.
+
+Questions, feature requests and bugs can be reported using the package's [issue
+system](https://github.com/thibautjombart/treespace/issues).
+
+
+
+
+Authors
+-------
+Authors:
+* [Thibaut Jombart](https://sites.google.com/site/thibautjombart/)
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
+
+Contributors:
+* [Jacob Almagro-Garcia](http://www.well.ox.ac.uk/jacob-almagro-garcia)
+* [Caroline Colijn](http://www.imperial.ac.uk/people/c.colijn)
+
+Maintainer of the CRAN version:
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
+
+
+
+See details of contributions on: <br>
+https://github.com/reconhub/outbreaker2/graphs/contributors
+
diff --git a/build/vignette.rds b/build/vignette.rds
new file mode 100644
index 0000000..de8b696
Binary files /dev/null and b/build/vignette.rds differ
diff --git a/data/DengueBEASTMCC.RData b/data/DengueBEASTMCC.RData
new file mode 100644
index 0000000..a6a9738
Binary files /dev/null and b/data/DengueBEASTMCC.RData differ
diff --git a/data/DengueSeqs.RData b/data/DengueSeqs.RData
new file mode 100644
index 0000000..61ad46f
Binary files /dev/null and b/data/DengueSeqs.RData differ
diff --git a/data/DengueTrees.RData b/data/DengueTrees.RData
new file mode 100644
index 0000000..d690549
Binary files /dev/null and b/data/DengueTrees.RData differ
diff --git a/data/fluTrees.RData b/data/fluTrees.RData
new file mode 100644
index 0000000..4b0ed53
Binary files /dev/null and b/data/fluTrees.RData differ
diff --git a/data/woodmiceTrees.RData b/data/woodmiceTrees.RData
new file mode 100644
index 0000000..181ca6f
Binary files /dev/null and b/data/woodmiceTrees.RData differ
diff --git a/inst/doc/DengueVignette.R b/inst/doc/DengueVignette.R
new file mode 100644
index 0000000..2226a48
--- /dev/null
+++ b/inst/doc/DengueVignette.R
@@ -0,0 +1,227 @@
+## ----setup, echo=FALSE---------------------------------------------------
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+
+## ----load, message=FALSE, warning=FALSE----------------------------------
+library("treespace")
+library("phangorn")
+
+## ----load_BEAST_trees----------------------------------------------------
+data(DengueTrees)
+
+## ----sample_BEAST_trees--------------------------------------------------
+set.seed(123)
+BEASTtrees <- DengueTrees[sample(1:length(DengueTrees),200)]
+
+## ----load_seqs-----------------------------------------------------------
+data(DengueSeqs)
+
+## ----make_NJ-------------------------------------------------------------
+makeTree <- function(x){
+ tree <- nj(dist.dna(x, model = "TN93"))
+ tree <- root(tree, resolve.root=TRUE, outgroup="D4Thai63")
+ tree
+}
+DnjRooted <- makeTree(DengueSeqs)
+plot(DnjRooted)
+
+## ----make_NJ_boots, results="hide"---------------------------------------
+Dnjboots <- boot.phylo(DnjRooted, DengueSeqs, B=100,
+ makeTree, trees=TRUE, rooted=TRUE)
+Dnjboots
+
+## ----see_NJ_boots--------------------------------------------------------
+plot(DnjRooted)
+drawSupportOnEdges(Dnjboots$BP)
+
+## ----make_ML, results="hide", message=FALSE------------------------------
+Dfit.ini <- pml(DnjRooted, as.phyDat(DengueSeqs), k=4)
+Dfit <- optim.pml(Dfit.ini, optNni=TRUE, optBf=TRUE,
+ optQ=TRUE, optGamma=TRUE, model="GTR")
+# root:
+DfitTreeRooted <- root(Dfit$tree, resolve.root=TRUE, outgroup="D4Thai63")
+
+## ----view_ML-------------------------------------------------------------
+plot(DfitTreeRooted)
+
+## ----make_ML_boots, results="hide"---------------------------------------
+# bootstrap supports:
+DMLboots <- bootstrap.pml(Dfit, optNni=TRUE)
+# root:
+DMLbootsrooted <- lapply(DMLboots, function(x) root(x, resolve.root=TRUE, outgroup="D4Thai63"))
+class(DMLbootsrooted) <- "multiPhylo"
+
+
+## ----see_ML_boots--------------------------------------------------------
+plotBS(DfitTreeRooted, DMLboots, type="phylogram")
+
+## ----run_treespace-------------------------------------------------------
+# collect the trees into a single object of class multiPhylo:
+DengueTrees <- c(BEASTtrees, Dnjboots$trees, DMLbootsrooted,
+ DnjRooted, DfitTreeRooted)
+class(DengueTrees) <- "multiPhylo"
+# add tree names:
+names(DengueTrees)[1:200] <- paste0("BEAST",1:200)
+names(DengueTrees)[201:300] <- paste0("NJ_boots",1:100)
+names(DengueTrees)[301:400] <- paste0("ML_boots",1:100)
+names(DengueTrees)[[401]] <- "NJ"
+names(DengueTrees)[[402]] <- "ML"
+# create vector corresponding to tree inference method:
+Dtype <- c(rep("BEAST",200),rep("NJboots",100),rep("MLboots",100),"NJ","ML")
+
+# use treespace to find and project the distances:
+Dscape <- treespace(DengueTrees, nf=5)
+
+# simple plot:
+plotGrovesD3(Dscape$pco, groups=Dtype)
+
+## ----make_better_plot----------------------------------------------------
+Dcols <- c("#1b9e77","#d95f02","#7570b3")
+Dmethod <- c(rep("BEAST",200),rep("NJ",100),rep("ML",100),"NJ","ML")
+Dbootstraps <- c(rep("replicates",400),"NJ","ML")
+Dhighlight <- c(rep(1,400),2,2)
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+
+## ----make_better_plot_with_labels----------------------------------------
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ treeNames = names(DengueTrees), # add the tree names as labels
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+
+## ----make_better_plot_with_tooltips--------------------------------------
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ tooltip_text = names(DengueTrees), # add the tree names as tooltip text
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+
+## ----scree_plot----------------------------------------------------------
+barplot(Dscape$pco$eig, col="navy")
+
+## ----load_rgl------------------------------------------------------------
+library(rgl)
+
+## ----plot_3D, rgl=TRUE, webgl=TRUE---------------------------------------
+Dcols3D <- c(rep(Dcols[[1]],200),rep(Dcols[[2]],100),rep(Dcols[[3]],100),Dcols[[2]],Dcols[[3]])
+rgl::plot3d(Dscape$pco$li[,1],Dscape$pco$li[,2],Dscape$pco$li[,3],
+ type="s",
+ size=c(rep(1.5,400),3,3),
+ col=Dcols3D,
+ xlab="", ylab="", zlab="")
+
+## ----NJ_and_ML_overlap---------------------------------------------------
+# trees with the same topology as the NJ tree:
+which(as.matrix(Dscape$D)["NJ",]==0)
+# trees with the same topology as the ML tree:
+which(as.matrix(Dscape$D)["ML",]==0)
+
+## ----compare_trees_NJ_v_ML-----------------------------------------------
+# comparing NJ and ML:
+plotTreeDiff(DnjRooted,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(DnjRooted,DfitTreeRooted)
+
+## ----make_BEAST_median---------------------------------------------------
+BEASTmed <- medTree(BEASTtrees)
+
+## ----compare_BEAST_meds--------------------------------------------------
+BEASTmed$trees
+treeDist(BEASTmed$trees[[1]],BEASTmed$trees[[2]])
+
+## ----save_BEAST_median---------------------------------------------------
+BEASTrep <- BEASTmed$trees[[1]]
+
+## ----compare_BEAST_to_other_trees----------------------------------------
+# comparing BEAST median and NJ:
+plotTreeDiff(BEASTrep,DnjRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DnjRooted)
+# comparing BEAST median and ML:
+plotTreeDiff(BEASTrep,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DfitTreeRooted)
+# comparing BEAST median to a random BEAST tree:
+num <- runif(1,1,200)
+randomBEASTtree <- BEASTtrees[[num]]
+plotTreeDiff(BEASTrep, randomBEASTtree, use.edge.length=FALSE)
+treeDist(BEASTrep,randomBEASTtree)
+
+## ----BEASTtrees----------------------------------------------------------
+# load the MCC tree
+data(DengueBEASTMCC)
+# concatenate with other BEAST trees
+BEAST201 <- c(BEASTtrees, DengueBEASTMCC)
+# compare using treespace:
+BEASTscape <- treespace(BEAST201, nf=5)
+# simple plot:
+plotGrovesD3(BEASTscape$pco)
+
+## ----BEASTtrees_clusters-------------------------------------------------
+# find clusters or 'groves':
+BEASTGroves <- findGroves(BEASTscape, nclust=4, clustering = "single")
+
+## ----BEASTtrees_meds-----------------------------------------------------
+# find median tree(s) per cluster:
+BEASTMeds <- medTree(BEAST201, groups=BEASTGroves$groups)
+# for each cluster, select a single median tree to represent it:
+BEASTMedTrees <- c(BEASTMeds$`1`$trees[[1]],
+ BEASTMeds$`2`$trees[[1]],
+ BEASTMeds$`3`$trees[[1]],
+ BEASTMeds$`4`$trees[[1]])
+
+## ----BEASTtrees_plot, warning=FALSE--------------------------------------
+# extract the numbers from the tree list 'BEASTtrees' which correspond to the median trees:
+BEASTMedTreeNums <-c(which(BEASTGroves$groups==1)[[BEASTMeds$`1`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==2)[[BEASTMeds$`2`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==3)[[BEASTMeds$`3`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==4)[[BEASTMeds$`4`$treenumbers[[1]]]])
+# prepare a vector to highlight median and MCC trees
+highlightTrees <- rep(1,201)
+highlightTrees[[201]] <- 2
+highlightTrees[BEASTMedTreeNums] <- 2
+# prepare colours:
+BEASTcols <- c("#66c2a5","#fc8d62","#8da0cb","#e78ac3")
+
+# plot:
+plotGrovesD3(BEASTscape$pco,
+ groups=as.vector(BEASTGroves$groups),
+ colors=BEASTcols,
+ col_lab="Cluster",
+ symbol_var = highlightTrees,
+ size_range = c(60,600),
+ size_var = highlightTrees,
+ legend_width=0)
+
+## ----BEASTtree_diffs-----------------------------------------------------
+# differences between the MCC tree and the median from the largest cluster:
+treeDist(DengueBEASTMCC,BEASTMedTrees[[1]])
+plotTreeDiff(DengueBEASTMCC,BEASTMedTrees[[1]], use.edge.length=FALSE)
+# differences between the median trees from clusters 1 and 2:
+treeDist(BEASTMedTrees[[1]],BEASTMedTrees[[2]])
+plotTreeDiff(BEASTMedTrees[[1]],BEASTMedTrees[[2]], use.edge.length=FALSE)
+
diff --git a/inst/doc/DengueVignette.Rmd b/inst/doc/DengueVignette.Rmd
new file mode 100644
index 0000000..42f9aac
--- /dev/null
+++ b/inst/doc/DengueVignette.Rmd
@@ -0,0 +1,338 @@
+---
+title: "treespace worked example: Dengue trees"
+author: "Michelle Kendall, Thibaut Jombart"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace worked example: Dengue trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+```
+
+
+This vignette demonstrates the use of *treespace* to compare a collection of trees.
+For this example we use trees inferred from 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997).
+We include a sample of trees from BEAST (v1.8), as well as creating neighbour-joining (NJ) and maximum-likelihood (ML) trees.
+
+
+Loading *treespace* and data:
+-------------
+
+Load the required packages:
+```{r load, message=FALSE, warning=FALSE}
+library("treespace")
+library("phangorn")
+```
+
+Load BEAST trees:
+```{r load_BEAST_trees}
+data(DengueTrees)
+```
+
+We load a random sample of 500 of the trees (from the second half of the posterior) produced using BEAST v1.8 with xml file 4 from Drummond and Rambaut (2007). It uses the standard GTR + Gamma + I substitution model with uncorrelated lognormal-distributed relaxed molecular clock. Each tree has 17 tips.
+
+For convenience in our initial analysis we will take a random sample of 200 of these trees; sample sizes can be increased later.
+```{r sample_BEAST_trees}
+set.seed(123)
+BEASTtrees <- DengueTrees[sample(1:length(DengueTrees),200)]
+```
+
+Load nucleotide sequences:
+```{r load_seqs}
+data(DengueSeqs)
+```
+
+Creating neighbour-joining and maximum likelihood trees:
+-------------
+
+Create a neighbour-joining (NJ) tree using the Tamura and Nei (1993) model (see `?dist.dna` for more information) and root it on the outgroup `"D4Thai63"`:
+```{r make_NJ}
+makeTree <- function(x){
+ tree <- nj(dist.dna(x, model = "TN93"))
+ tree <- root(tree, resolve.root=TRUE, outgroup="D4Thai63")
+ tree
+}
+DnjRooted <- makeTree(DengueSeqs)
+plot(DnjRooted)
+```
+
+We use `boot.phylo` to bootstrap the tree:
+```{r make_NJ_boots, results="hide"}
+Dnjboots <- boot.phylo(DnjRooted, DengueSeqs, B=100,
+ makeTree, trees=TRUE, rooted=TRUE)
+Dnjboots
+```
+
+and we can plot the tree again, annotating it with the bootstrap clade support values:
+```{r see_NJ_boots}
+plot(DnjRooted)
+drawSupportOnEdges(Dnjboots$BP)
+```
+
+We create a maximum-likelihood (ML) tree and root it as before:
+```{r make_ML, results="hide", message=FALSE}
+Dfit.ini <- pml(DnjRooted, as.phyDat(DengueSeqs), k=4)
+Dfit <- optim.pml(Dfit.ini, optNni=TRUE, optBf=TRUE,
+ optQ=TRUE, optGamma=TRUE, model="GTR")
+# root:
+DfitTreeRooted <- root(Dfit$tree, resolve.root=TRUE, outgroup="D4Thai63")
+```
+
+View the ML tree:
+```{r view_ML}
+plot(DfitTreeRooted)
+```
+
+Create bootstrap trees:
+```{r make_ML_boots, results="hide"}
+# bootstrap supports:
+DMLboots <- bootstrap.pml(Dfit, optNni=TRUE)
+# root:
+DMLbootsrooted <- lapply(DMLboots, function(x) root(x, resolve.root=TRUE, outgroup="D4Thai63"))
+class(DMLbootsrooted) <- "multiPhylo"
+
+```
+
+Plot the ML tree again, with bootstrap support values:
+```{r see_ML_boots}
+plotBS(DfitTreeRooted, DMLboots, type="phylogram")
+```
+
+Using *treespace* to compare trees
+-------------
+
+We now use the function `treespace` to find and plot distances between all these trees:
+
+```{r run_treespace}
+# collect the trees into a single object of class multiPhylo:
+DengueTrees <- c(BEASTtrees, Dnjboots$trees, DMLbootsrooted,
+ DnjRooted, DfitTreeRooted)
+class(DengueTrees) <- "multiPhylo"
+# add tree names:
+names(DengueTrees)[1:200] <- paste0("BEAST",1:200)
+names(DengueTrees)[201:300] <- paste0("NJ_boots",1:100)
+names(DengueTrees)[301:400] <- paste0("ML_boots",1:100)
+names(DengueTrees)[[401]] <- "NJ"
+names(DengueTrees)[[402]] <- "ML"
+# create vector corresponding to tree inference method:
+Dtype <- c(rep("BEAST",200),rep("NJboots",100),rep("MLboots",100),"NJ","ML")
+
+# use treespace to find and project the distances:
+Dscape <- treespace(DengueTrees, nf=5)
+
+# simple plot:
+plotGrovesD3(Dscape$pco, groups=Dtype)
+```
+
+The function `plotGrovesD3` produces interactive d3 plots which enable zooming, moving, tooltip text and legend hovering. We now refine the plot with colour-blind friendly colours (selected using [ColorBrewer2](http://colorbrewer2.org/)), bigger points, varying symbols and point opacity to demonstrate the NJ and ML trees, informative legend title and smaller legend width:
+
+```{r make_better_plot}
+Dcols <- c("#1b9e77","#d95f02","#7570b3")
+Dmethod <- c(rep("BEAST",200),rep("NJ",100),rep("ML",100),"NJ","ML")
+Dbootstraps <- c(rep("replicates",400),"NJ","ML")
+Dhighlight <- c(rep(1,400),2,2)
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+We can also add tree labels to the plot. Where these overlap, the user can use "drag and drop" to move them around for better visibility.
+
+```{r make_better_plot_with_labels}
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ treeNames = names(DengueTrees), # add the tree names as labels
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+Alternatively, where labels are too cluttered, it may be preferable not to plot them but to make the tree names available as tooltip text instead:
+```{r make_better_plot_with_tooltips}
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ tooltip_text = names(DengueTrees), # add the tree names as tooltip text
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+The scree plot is available as part of the `treespace` output:
+```{r scree_plot}
+barplot(Dscape$pco$eig, col="navy")
+```
+
+We can also view the plot in 3D:
+```{r load_rgl}
+library(rgl)
+```
+
+```{r plot_3D, rgl=TRUE, webgl=TRUE}
+Dcols3D <- c(rep(Dcols[[1]],200),rep(Dcols[[2]],100),rep(Dcols[[3]],100),Dcols[[2]],Dcols[[3]])
+rgl::plot3d(Dscape$pco$li[,1],Dscape$pco$li[,2],Dscape$pco$li[,3],
+ type="s",
+ size=c(rep(1.5,400),3,3),
+ col=Dcols3D,
+ xlab="", ylab="", zlab="")
+```
+
+*treespace* analysis
+-------------
+
+From these plots we can see that *treespace* has identified variation in the trees according to the Kendall Colijn metric ($\lambda=0$, ignoring branch lengths).
+The NJ and ML bootstrap trees have broadly similar topologies but are different from any of the BEAST trees.
+We can check whether any bootstrap trees have the same topology as either the NJ or ML tree, as follows:
+
+```{r NJ_and_ML_overlap}
+# trees with the same topology as the NJ tree:
+which(as.matrix(Dscape$D)["NJ",]==0)
+# trees with the same topology as the ML tree:
+which(as.matrix(Dscape$D)["ML",]==0)
+```
+
+This shows that the NJ tree has the same topology as one NJ bootstrap tree and one ML bootstrap tree. The ML tree has the same topology as 15 ML bootstrap trees, but no NJ bootstrap trees.
+
+We can compare pairs of trees using the `plotTreeDiff` function to see exactly where their differences arise.
+Tips with identical ancestry in the two trees are coloured grey, whereas tips with differing ancestry are coloured peach-red, with the colour darkening according to the number of ancestral differences found at each tip.
+Since we are comparing the trees topologically (ignoring branch lengths, for the moment), we plot with constant branch lengths for clarity.
+```{r compare_trees_NJ_v_ML}
+# comparing NJ and ML:
+plotTreeDiff(DnjRooted,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(DnjRooted,DfitTreeRooted)
+```
+
+For pairwise comparisons it is helpful to find a small number of representative trees.
+We can find a geometric median tree from the BEAST trees using the `medTree` function:
+```{r make_BEAST_median}
+BEASTmed <- medTree(BEASTtrees)
+```
+
+There are two median trees, with identical topology:
+```{r compare_BEAST_meds}
+BEASTmed$trees
+treeDist(BEASTmed$trees[[1]],BEASTmed$trees[[2]])
+```
+
+so we may select one of them as a BEAST representative tree.
+Note that for a more thorough analysis it may be appropriate to identify clusters among the BEAST trees and select a summary tree from each cluster: we demonstrate this approach later in the vignette.
+
+```{r save_BEAST_median}
+BEASTrep <- BEASTmed$trees[[1]]
+```
+
+```{r compare_BEAST_to_other_trees}
+# comparing BEAST median and NJ:
+plotTreeDiff(BEASTrep,DnjRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DnjRooted)
+# comparing BEAST median and ML:
+plotTreeDiff(BEASTrep,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DfitTreeRooted)
+# comparing BEAST median to a random BEAST tree:
+num <- runif(1,1,200)
+randomBEASTtree <- BEASTtrees[[num]]
+plotTreeDiff(BEASTrep, randomBEASTtree, use.edge.length=FALSE)
+treeDist(BEASTrep,randomBEASTtree)
+```
+
+Using *treespace* to analyse the BEAST trees in more detail:
+-------------
+
+We used TreeAnnotator (Drummond and Rambaut, 2007) to create a Maximum Clade Credibility (MCC) tree from amongst the BEAST trees.
+```{r BEASTtrees}
+# load the MCC tree
+data(DengueBEASTMCC)
+# concatenate with other BEAST trees
+BEAST201 <- c(BEASTtrees, DengueBEASTMCC)
+# compare using treespace:
+BEASTscape <- treespace(BEAST201, nf=5)
+# simple plot:
+plotGrovesD3(BEASTscape$pco)
+```
+
+There appear to be clusters of tree topologies within the BEAST trees. We can use the function `findGroves` to identify clusters:
+```{r BEASTtrees_clusters}
+# find clusters or 'groves':
+BEASTGroves <- findGroves(BEASTscape, nclust=4, clustering = "single")
+```
+
+and to find a median tree per cluster:
+```{r BEASTtrees_meds}
+# find median tree(s) per cluster:
+BEASTMeds <- medTree(BEAST201, groups=BEASTGroves$groups)
+# for each cluster, select a single median tree to represent it:
+BEASTMedTrees <- c(BEASTMeds$`1`$trees[[1]],
+ BEASTMeds$`2`$trees[[1]],
+ BEASTMeds$`3`$trees[[1]],
+ BEASTMeds$`4`$trees[[1]])
+```
+
+We can now make the plot again, highlighting the MCC tree and the four median trees:
+```{r BEASTtrees_plot, warning=FALSE}
+# extract the numbers from the tree list 'BEASTtrees' which correspond to the median trees:
+BEASTMedTreeNums <-c(which(BEASTGroves$groups==1)[[BEASTMeds$`1`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==2)[[BEASTMeds$`2`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==3)[[BEASTMeds$`3`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==4)[[BEASTMeds$`4`$treenumbers[[1]]]])
+# prepare a vector to highlight median and MCC trees
+highlightTrees <- rep(1,201)
+highlightTrees[[201]] <- 2
+highlightTrees[BEASTMedTreeNums] <- 2
+# prepare colours:
+BEASTcols <- c("#66c2a5","#fc8d62","#8da0cb","#e78ac3")
+
+# plot:
+plotGrovesD3(BEASTscape$pco,
+ groups=as.vector(BEASTGroves$groups),
+ colors=BEASTcols,
+ col_lab="Cluster",
+ symbol_var = highlightTrees,
+ size_range = c(60,600),
+ size_var = highlightTrees,
+ legend_width=0)
+```
+
+To understand the differences between the representative trees we can use `plotTreeDiff` again, for example:
+```{r BEASTtree_diffs}
+# differences between the MCC tree and the median from the largest cluster:
+treeDist(DengueBEASTMCC,BEASTMedTrees[[1]])
+plotTreeDiff(DengueBEASTMCC,BEASTMedTrees[[1]], use.edge.length=FALSE)
+# differences between the median trees from clusters 1 and 2:
+treeDist(BEASTMedTrees[[1]],BEASTMedTrees[[2]])
+plotTreeDiff(BEASTMedTrees[[1]],BEASTMedTrees[[2]], use.edge.length=FALSE)
+```
+
+
+References
+--------------
+[1] Drummond, A. J., and Rambaut, A. (2007) BEAST: Bayesian evolutionary analysis by sampling trees. BMC Evolutionary Biology, 7(1), 214.
+
+[2] Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997) Molecular evolution and phylogeny of dengue-4 viruses. Journal of General Virology, 78(9), 2279-2286.
+
diff --git a/inst/doc/DengueVignette.html b/inst/doc/DengueVignette.html
new file mode 100644
index 0000000..061962c
--- /dev/null
+++ b/inst/doc/DengueVignette.html
@@ -0,0 +1,3566 @@
+<!DOCTYPE html>
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+
+<meta charset="utf-8">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="pandoc" />
+
+<meta name="viewport" content="width=device-width, initial-scale=1">
+
+<meta name="author" content="Michelle Kendall, Thibaut Jombart" />
+
+
+<title>treespace worked example: Dengue trees</title>
+
+<script src="data:application/x-javascript;base64,KGZ1bmN0aW9uKCkgewogIC8vIElmIHdpbmRvdy5IVE1MV2lkZ2V0cyBpcyBhbHJlYWR5IGRlZmluZWQsIHRoZW4gdXNlIGl0OyBvdGhlcndpc2UgY3JlYXRlIGEKICAvLyBuZXcgb2JqZWN0LiBUaGlzIGFsbG93cyBwcmVjZWRpbmcgY29kZSB0byBzZXQgb3B0aW9ucyB0aGF0IGFmZmVjdCB0aGUKICAvLyBpbml0aWFsaXphdGlvbiBwcm9jZXNzICh0aG91Z2ggbm9uZSBjdXJyZW50bHkgZXhpc3QpLgogIHdpbmRvdy5IVE1MV2lkZ2V0cyA9IHdpbmRvdy5IVE1MV2lkZ2V0cyB8fCB7fTsKCiAgLy8gU2VlIGlmIHdlJ3JlIHJ1bm5pbmcgaW4gYSB2aWV3ZXIgcGFuZS4gSWYgbm90LCB3ZS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1jb2xvci8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxlKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2UoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sZSk6ZSh0LmQzPXQuZDN8fHt9KX0odGhpcyxmdW5jdGlvbih0KXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gZSh0LGUsbil7dC5wcm90b3R5cGU9ZS5wcm90b3R5cGU9bixuLmNvbnN0cnVjdG9yPXR9ZnVuY3Rpb24gbi [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1hcnJheS8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24obixyKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP3IoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0scik6cihuLmQzPW4uZDN8fHt9KX0odGhpcyxmdW5jdGlvbihuKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gcihuLHIpe3JldHVybiBuPHI/LTE6bj5yPzE6bj49cj8wOk5hTn1mdW5jdGlvbiB0KG4pe3JldHVybiAxPT [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1jb2xsZWN0aW9uLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihuLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSx0KTp0KG4uZDM9bi5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiB0KCl7fWZ1bmN0aW9uIGUobixlKXt2YXIgcj1uZXcgdDtpZihuIGluc3RhbmNlb2YgdCluLmVhY2 [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1mb3JtYXQvIFZlcnNpb24gMS4wLjIuIENvcHlyaWdodCAyMDE2IE1pa2UgQm9zdG9jay4KIWZ1bmN0aW9uKHQsbil7Im9iamVjdCI9PXR5cGVvZiBleHBvcnRzJiYidW5kZWZpbmVkIiE9dHlwZW9mIG1vZHVsZT9uKGV4cG9ydHMpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyJdLG4pOm4odC5kMz10LmQzfHx7fSl9KHRoaXMsZnVuY3Rpb24odCl7InVzZSBzdHJpY3QiO2Z1bmN0aW9uIG4odCxuKXtpZigocj0odD1uP3QudG9FeHBvbmVudGlhbChuLTEpOnQudG9FeHBvbmVudGlhbCgpKS5pbm [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1kaXNwYXRjaC8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24obixlKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2UoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sZSk6ZShuLmQzPW4uZDN8fHt9KX0odGhpcyxmdW5jdGlvbihuKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gZSgpe2Zvcih2YXIgbixlPTAscj1hcmd1bWVudHMubGVuZ3RoLG89e307ZTxyOysrZSl7aWYoIShuPW [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1lYXNlLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihuLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSx0KTp0KG4uZDM9bi5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiB0KG4pe3JldHVybitufWZ1bmN0aW9uIGUobil7cmV0dXJuIG4qbn1mdW5jdGlvbiB1KG4pe3JldHVybiBuKi [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1pbnRlcnBvbGF0ZS8gVmVyc2lvbiAxLjEuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyxyZXF1aXJlKCJkMy1jb2xvciIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiLCJkMy1jb2xvciJdLG4pOm4odC5kMz10LmQzfHx7fSx0LmQzKX0odGhpcyxmdW5jdGlvbih0LG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiByKHQsbixyLGUsbyl7dmFyIG [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zZWxlY3Rpb24vIFZlcnNpb24gMS4wLjIuIENvcHlyaWdodCAyMDE2IE1pa2UgQm9zdG9jay4KIWZ1bmN0aW9uKHQsbil7Im9iamVjdCI9PXR5cGVvZiBleHBvcnRzJiYidW5kZWZpbmVkIiE9dHlwZW9mIG1vZHVsZT9uKGV4cG9ydHMpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyJdLG4pOm4odC5kMz10LmQzfHx7fSl9KHRoaXMsZnVuY3Rpb24odCl7InVzZSBzdHJpY3QiO2Z1bmN0aW9uIG4odCl7dmFyIG49dCs9IiIsZT1uLmluZGV4T2YoIjoiKTtyZXR1cm4gZT49MCYmInhtbG5zIiE9PS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zY2FsZS8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24oZSxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyxyZXF1aXJlKCJkMy1hcnJheSIpLHJlcXVpcmUoImQzLWNvbGxlY3Rpb24iKSxyZXF1aXJlKCJkMy1pbnRlcnBvbGF0ZSIpLHJlcXVpcmUoImQzLWZvcm1hdCIpLHJlcXVpcmUoImQzLXRpbWUiKSxyZXF1aXJlKCJkMy10aW1lLWZvcm1hdCIpLHJlcXVpcmUoImQzLWNvbG9yIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZW [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy10aW1lci8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sbik6bih0LmQzPXQuZDN8fHt9KX0odGhpcyxmdW5jdGlvbih0KXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gbigpe3JldHVybiB4fHwoVChlKSx4PWIubm93KCkrdyl9ZnVuY3Rpb24gZSgpe3g9MH1mdW5jdGlvbiBpKC [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy10cmFuc2l0aW9uLyBWZXJzaW9uIDEuMC4yLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LG4peyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/bihleHBvcnRzLHJlcXVpcmUoImQzLXNlbGVjdGlvbiIpLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtdGltZXIiKSxyZXF1aXJlKCJkMy1pbnRlcnBvbGF0ZSIpLHJlcXVpcmUoImQzLWNvbG9yIikscmVxdWlyZSgiZDMtZWFzZSIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZm [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1kcmFnLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihlLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtc2VsZWN0aW9uIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyIsImQzLWRpc3BhdGNoIiwiZDMtc2VsZWN0aW9uIl0sdCk6dChlLmQzPWUuZDN8fHt9LGUuZDMsZS5kMyl9KHRoaXMsZnVuY3Rpb24oZS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1wYXRoLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LHMpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/cyhleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSxzKTpzKHQuZDM9dC5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKHQpeyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiBzKCl7dGhpcy5feDA9dGhpcy5feTA9dGhpcy5feDE9dGhpcy5feTE9bnVsbCx0aGlzLl89W119ZnVuY3Rpb2 [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zaGFwZS8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxpKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2koZXhwb3J0cyxyZXF1aXJlKCJkMy1wYXRoIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyIsImQzLXBhdGgiXSxpKTppKHQuZDM9dC5kM3x8e30sdC5kMyl9KHRoaXMsZnVuY3Rpb24odCxpKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gbih0KXtyZXR1cm4gZnVuY3Rpb24oKXtyZX [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1heGlzLyBWZXJzaW9uIDEuMC4zLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LG4peyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/bihleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSxuKTpuKHQuZDM9dC5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKHQpeyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiBuKHQpe3JldHVybiB0fWZ1bmN0aW9uIGUodCxuLGUpe3ZhciByPXQoZSk7cmV0dXJuInRyYW5zbGF0ZSgiKy [...]
+<script src="data:application/x-javascript;base64,IWZ1bmN0aW9uIGEoYixjLGQpe2Z1bmN0aW9uIGUoZyxoKXtpZighY1tnXSl7aWYoIWJbZ10pe3ZhciBpPSJmdW5jdGlvbiI9PXR5cGVvZiByZXF1aXJlJiZyZXF1aXJlO2lmKCFoJiZpKXJldHVybiBpKGcsITApO2lmKGYpcmV0dXJuIGYoZywhMCk7dmFyIGo9bmV3IEVycm9yKCJDYW5ub3QgZmluZCBtb2R1bGUgJyIrZysiJyIpO3Rocm93IGouY29kZT0iTU9EVUxFX05PVF9GT1VORCIsan12YXIgaz1jW2ddPXtleHBvcnRzOnt9fTtiW2ddWzBdLmNhbGwoay5leHBvcnRzLGZ1bmN0aW9uKGEpe3ZhciBjPWJbZ11bMV1bYV07cmV0dXJuIGUoYz9jOmEpfSxrLGsuZXhwb3J0cyxhLGIsYy [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy16b29tLyBWZXJzaW9uIDEuMC4zLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LGUpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/ZShleHBvcnRzLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtZHJhZyIpLHJlcXVpcmUoImQzLWludGVycG9sYXRlIikscmVxdWlyZSgiZDMtc2VsZWN0aW9uIikscmVxdWlyZSgiZDMtdHJhbnNpdGlvbiIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiLCJkMy1kaX [...]
+<link href="data:text/css;charset=utf-8,%2Elasso%20path%20%7B%0Astroke%3A%20rgb%2880%2C80%2C80%29%3B%0Astroke%2Dwidth%3A%202px%3B%0A%7D%0A%2Elasso%20%2Edrawn%20%7B%0Afill%3A%20%23CCCCCC%3B%0Afill%2Dopacity%3A%20%2E15%20%3B%0A%7D%0A%2Elasso%20%2Eloop%5Fclose%20%7B%0Afill%3A%20none%3B%0Astroke%2Ddasharray%3A%204%2C4%3B%0A%7D%0A%2Elasso%20%2Eorigin%20%7B%0Afill%3A%20%233399FF%3B%0Afill%2Dopacity%3A%20%2E5%3B%0A%7D%0A%2EscatterD3%20%2Enot%2Dpossible%2Dlasso%20%7B%0Afill%3A%20rgb%28150%2C150% [...]
+<script src="data:application/x-javascript;base64,ZDMubGFzc28gPSBmdW5jdGlvbigpIHsKCiAgICB2YXIgaXRlbXMgPSBudWxsLAogICAgICAgIGNsb3NlUGF0aERpc3RhbmNlID0gNzUsCiAgICAgICAgY2xvc2VQYXRoU2VsZWN0ID0gdHJ1ZSwKICAgICAgICBpc1BhdGhDbG9zZWQgPSBmYWxzZSwKICAgICAgICBob3ZlclNlbGVjdCA9IHRydWUsCiAgICAgICAgcG9pbnRzID0gW10sCiAgICAgICAgYXJlYSA9IG51bGwsCiAgICAgICAgb24gPSB7c3RhcnQ6ZnVuY3Rpb24oKXt9LCBkcmF3OiBmdW5jdGlvbigpe30sIGVuZDogZnVuY3Rpb24oKXt9fTsKCiAgICBmdW5jdGlvbiBsYXNzbyhzZWxlY3Rpb24pIHsKCiAgICAgICAgLy8gdG [...]
+<link href="data:text/css;charset=utf-8,%0A%2EscatterD3%2Dtooltip%20%7B%0Aposition%3A%20absolute%3B%0Acolor%3A%20%23222%3B%0Abackground%3A%20%23fff%3B%0Apadding%3A%20%2E5em%3B%0Atext%2Dshadow%3A%20%23f5f5f5%200%201px%200%3B%0Aborder%2Dradius%3A%202px%3B%0Abox%2Dshadow%3A%200px%200px%207px%201px%20%23a6a6a6%3B%0Aopacity%3A%200%2E95%3B%0Afont%2Dfamily%3A%20Open%20Sans%2C%20Droid%20Sans%2C%20Helvetica%2C%20Verdana%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2010px%3B%0Az%2Dindex%3A%2010%3B%0A%7D% [...]
+<script src="data:application/x-javascript;base64,Ly8gQ2xlYW4gdmFyaWFibGVzIGxldmVscyB0byBiZSB2YWxpZCBDU1MgY2xhc3NlcwpmdW5jdGlvbiBjc3NfY2xlYW4ocykgewogICAgaWYgKHMgPT09IHVuZGVmaW5lZCkgcmV0dXJuICIiOwogICAgcmV0dXJuIHMudG9TdHJpbmcoKS5yZXBsYWNlKC9bXlx3LV0vZywgIl8iKTsKfQoKLy8gRGVmYXVsdCB0cmFuc2xhdGlvbiBmdW5jdGlvbiBmb3IgcG9pbnRzIGFuZCBsYWJlbHMKZnVuY3Rpb24gdHJhbnNsYXRpb24oZCwgc2NhbGVzKSB7CiAgICAgcmV0dXJuICJ0cmFuc2xhdGUoIiArIHNjYWxlcy54KGQueCkgKyAiLCIgKyBzY2FsZXMueShkLnkpICsgIikiOwp9CgovLyBDcmVhdG [...]
+<script src="data:application/x-javascript;base64,Ly8gQ3VzdG9tIGNvbG9yIHNjaGVtZQpmdW5jdGlvbiBjdXN0b21fc2NoZW1lMTAgKCkgewogICAgLy8gc2xpY2UoKSB0byBjcmVhdGUgYSBjb3B5CiAgICB2YXIgc2NoZW1lID0gZDMuc2NoZW1lQ2F0ZWdvcnkxMC5zbGljZSgpOwogICAgLy8gU3dpdGNoIG9yYW5nZSBhbmQgcmVkCiAgICB2YXIJdG1wID0gc2NoZW1lWzNdOwogICAgc2NoZW1lWzNdID0gc2NoZW1lWzFdOwogICAgc2NoZW1lWzFdID0gdG1wOwogICAgcmV0dXJuIHNjaGVtZTsKfQoKLy8gU2V0dXAgZGltZW5zaW9ucwpmdW5jdGlvbiBzZXR1cF9zaXplcyAod2lkdGgsIGhlaWdodCwgc2V0dGluZ3MpIHsKCiAgICB2YX [...]
+<script src="data:application/x-javascript;base64,Ly8gQ3JlYXRlIGFuZCBkcmF3IHggYW5kIHkgYXhlcwpmdW5jdGlvbiBhZGRfYXhlcyhzZWxlY3Rpb24sIGRpbXMsIHNldHRpbmdzLCBzY2FsZXMpIHsKCiAgICAvLyB4IGF4aXMKICAgIHNlbGVjdGlvbi5hcHBlbmQoImciKQogICAgICAgIC5hdHRyKCJjbGFzcyIsICJ4IGF4aXMiKQogICAgICAgIC5hdHRyKCJ0cmFuc2Zvcm0iLCAidHJhbnNsYXRlKDAsIiArIGRpbXMuaGVpZ2h0ICsgIikiKQogICAgICAgIC5zdHlsZSgiZm9udC1zaXplIiwgc2V0dGluZ3MuYXhlc19mb250X3NpemUpCiAgICAgICAgLmNhbGwoc2NhbGVzLnhBeGlzKTsKCiAgICAvLyB5IGF4aXMKICAgIHNlbGVjdG [...]
+<script src="data:application/x-javascript;base64,Ly8gUmV0dXJucyBkb3Qgc2l6ZSBmcm9tIGFzc29jaWF0ZWQgZGF0YQpmdW5jdGlvbiBkb3Rfc2l6ZShkYXRhLCBzZXR0aW5ncywgc2NhbGVzKSB7CiAgICB2YXIgc2l6ZSA9IHNldHRpbmdzLnBvaW50X3NpemU7CiAgICBpZiAoc2V0dGluZ3MuaGFzX3NpemVfdmFyKSB7IHNpemUgPSBzY2FsZXMuc2l6ZShkYXRhLnNpemVfdmFyKTsgfQogICAgcmV0dXJuKHNpemUpOwp9CgovLyBJbml0aWFsIGRvdCBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGRvdF9pbml0IChzZWxlY3Rpb24sIHNldHRpbmdzLCBzY2FsZXMpIHsKICAgIC8vIHRvb2x0aXBzIHdoZW4gaG92ZXJpbmcgcG9pbnRzCiAgICB2YX [...]
+<script src="data:application/x-javascript;base64,CmZ1bmN0aW9uIGFkZF9hcnJvd3NfZGVmcyhzdmcsIHNldHRpbmdzLCBzY2FsZXMpIHsKICAgIC8vIDxkZWZzPgogICAgdmFyIGRlZnMgPSBzdmcuYXBwZW5kKCJkZWZzIik7CiAgICAvLyBhcnJvdyBoZWFkIG1hcmtlcnMKICAgIHNjYWxlcy5jb2xvci5yYW5nZSgpLmZvckVhY2goZnVuY3Rpb24oZCkgewogICAgICAgIGRlZnMuYXBwZW5kKCJtYXJrZXIiKQoJICAgIC5hdHRyKCJpZCIsICJhcnJvdy1oZWFkLSIgKyBzZXR0aW5ncy5odG1sX2lkICsgIi0iICsgZCkKCSAgICAuYXR0cigibWFya2VyV2lkdGgiLCAiMTAiKQoJICAgIC5hdHRyKCJtYXJrZXJIZWlnaHQiLCAiMTAiKQoJIC [...]
+<script src="data:application/x-javascript;base64,Ci8vIEluaXRpYWwgdGV4dCBsYWJlbCBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGxhYmVsX2luaXQgKHNlbGVjdGlvbikgewogICAgc2VsZWN0aW9uCiAgICAgICAgLmF0dHIoInRleHQtYW5jaG9yIiwgIm1pZGRsZSIpOwp9CgovLyBDb21wdXRlIGRlZmF1bHQgdmVydGljYWwgb2Zmc2V0IGZvciBsYWJlbHMKZnVuY3Rpb24gZGVmYXVsdF9sYWJlbF9keShzaXplLCB5LCB0eXBlX3ZhcixzZXR0aW5ncykgewogICAgaWYgKHkgPCAwICYmIHR5cGVfdmFyICE9PSB1bmRlZmluZWQgJiYgdHlwZV92YXIgPT0gImFycm93IikgewogICAgICAgIHJldHVybiAoTWF0aC5zcXJ0KHNpemUpIC8gMikgKy [...]
+<script src="data:application/x-javascript;base64,Ly8gWmVybyBob3Jpem9udGFsIGFuZCB2ZXJ0aWNhbCBsaW5lcwp2YXIgZHJhd19saW5lID0gZDMubGluZSgpCiAgICAueChmdW5jdGlvbihkKSB7cmV0dXJuIGQueDt9KQogICAgLnkoZnVuY3Rpb24oZCkge3JldHVybiBkLnk7fSk7CgpmdW5jdGlvbiBsaW5lX2luaXQoc2VsZWN0aW9uKSB7CiAgICBzZWxlY3Rpb24KCS5hdHRyKCJjbGFzcyIsICJsaW5lIik7CgogICAgcmV0dXJuIHNlbGVjdGlvbjsKfQoKZnVuY3Rpb24gbGluZV9mb3JtYXR0aW5nKHNlbGVjdGlvbiwgZGltcywgc2V0dGluZ3MsIHNjYWxlcykgewogICAgc2VsZWN0aW9uCgkuYXR0cigiZCIsIGZ1bmN0aW9uKGQpIH [...]
+<script src="data:application/x-javascript;base64,Ci8vIEluaXRpYWwgZWxsaXBzZSBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGVsbGlwc2VfaW5pdChzZWxlY3Rpb24pIHsKICAgIHNlbGVjdGlvbgogICAgICAgIC5zdHlsZSgiZmlsbCIsICJub25lIik7Cn0KCi8vIEFwcGx5IGZvcm1hdCB0byBlbGxpcHNlCmZ1bmN0aW9uIGVsbGlwc2VfZm9ybWF0dGluZyhzZWxlY3Rpb24sIHNldHRpbmdzLCBzY2FsZXMpIHsKCiAgICAvLyBFbGxpcHNlcyBwYXRoIGZ1bmN0aW9uCiAgICB2YXIgZWxsaXBzZUZ1bmMgPSBkMy5saW5lKCkKICAgICAgICAueChmdW5jdGlvbihkKSB7IHJldHVybiBzY2FsZXMueChkLngpOyB9KQogICAgICAgIC55KGZ1bmN0aW [...]
+<script src="data:application/x-javascript;base64,Ly8gRm9ybWF0IGxlZ2VuZCBsYWJlbApmdW5jdGlvbiBsZWdlbmRfbGFiZWxfZm9ybWF0dGluZyAoc2VsZWN0aW9uKSB7CiAgICBzZWxlY3Rpb24KICAgICAgICAuc3R5bGUoInRleHQtYW5jaG9yIiwgImJlZ2lubmluZyIpCiAgICAgICAgLnN0eWxlKCJmaWxsIiwgIiMwMDAiKQogICAgICAgIC5zdHlsZSgiZm9udC13ZWlnaHQiLCAiYm9sZCIpOwp9CgovLyBDcmVhdGUgY29sb3IgbGVnZW5kCmZ1bmN0aW9uIGFkZF9jb2xvcl9sZWdlbmQoc3ZnLCBkaW1zLCBzZXR0aW5ncywgc2NhbGVzLCBkdXJhdGlvbikgewoKICAgIC8vIERlZmF1bHQgdHJhbnNpdGlvbiBkdXJhdGlvbiB0byAwCi [...]
+<script src="data:application/x-javascript;base64,Ly8gTGFzc28gZnVuY3Rpb25zIHRvIGV4ZWN1dGUgd2hpbGUgbGFzc29pbmcKdmFyIGxhc3NvX3N0YXJ0ID0gZnVuY3Rpb24obGFzc28pIHsKICAgIGxhc3NvLml0ZW1zKCkKICAgICAgICAuZWFjaChmdW5jdGlvbihkKXsKCSAgICBpZiAoZDMuc2VsZWN0KHRoaXMpLmNsYXNzZWQoJ2RvdCcpKSB7CiAgICAgICAgICAgICAgICBkLnNjYXR0ZXJEM19sYXNzb19kb3Rfc3Ryb2tlID0gZC5zY2F0dGVyRDNfbGFzc29fZG90X3N0cm9rZSA/IGQuc2NhdHRlckQzX2xhc3NvX2RvdF9zdHJva2UgOiBkMy5zZWxlY3QodGhpcykuc3R5bGUoInN0cm9rZSIpOwogICAgICAgICAgICAgICAgZC5zY2 [...]
+<script src="data:application/x-javascript;base64,Ly8gRXhwb3J0IHRvIFNWRyBmdW5jdGlvbgpmdW5jdGlvbiBleHBvcnRfc3ZnKHNlbCwgc3ZnLCBzZXR0aW5ncykgewogICAgdmFyIHN2Z19jb250ZW50ID0gc3ZnCiAgICAgICAgLmF0dHIoInhtbG5zIiwgImh0dHA6Ly93d3cudzMub3JnLzIwMDAvc3ZnIikKICAgICAgICAuYXR0cigidmVyc2lvbiIsIDEuMSkKICAgICAgICAubm9kZSgpLnBhcmVudE5vZGUuaW5uZXJIVE1MOwogICAgLy8gRGlydHkgZGlydHkgZGlydHkuLi4KICAgIHN2Z19jb250ZW50ID0gc3ZnX2NvbnRlbnQucmVwbGFjZSgvPGcgY2xhc3M9ImdlYXItbWVudVtcc1xTXSo/PFwvZz4vLCAnJyk7CiAgICBzdmdfY2 [...]
+<script src="data:application/x-javascript;base64,ZnVuY3Rpb24gc2NhdHRlckQzKCkgewoKICAgIHZhciB3aWR0aCA9IDYwMCwgLy8gZGVmYXVsdCB3aWR0aAoJaGVpZ2h0ID0gNjAwLCAvLyBkZWZhdWx0IGhlaWdodAoJZGltcyA9IHt9LAoJc2V0dGluZ3MgPSB7fSwKCXNjYWxlcyA9IHt9LAoJZGF0YSA9IFtdLAoJc3ZnLAoJem9vbSwgZHJhZzsKCiAgICAvLyBab29tIGJlaGF2aW9yCiAgICB6b29tID0gZDMuem9vbSgpCiAgICAgICAgLnNjYWxlRXh0ZW50KFswLCAzMl0pCiAgICAgICAgLm9uKCJ6b29tIiwgem9vbWVkKTsKCiAgICAvLyBab29tIGZ1bmN0aW9uCiAgICBmdW5jdGlvbiB6b29tZWQocmVzZXQpIHsKCXZhciByb290ID [...]
+
+
+<style type="text/css">code{white-space: pre;}</style>
+<style type="text/css">
+div.sourceCode { overflow-x: auto; }
+table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
+ margin: 0; padding: 0; vertical-align: baseline; border: none; }
+table.sourceCode { width: 100%; line-height: 100%; }
+td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
+td.sourceCode { padding-left: 5px; }
+code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
+code > span.dt { color: #902000; } /* DataType */
+code > span.dv { color: #40a070; } /* DecVal */
+code > span.bn { color: #40a070; } /* BaseN */
+code > span.fl { color: #40a070; } /* Float */
+code > span.ch { color: #4070a0; } /* Char */
+code > span.st { color: #4070a0; } /* String */
+code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
+code > span.ot { color: #007020; } /* Other */
+code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
+code > span.fu { color: #06287e; } /* Function */
+code > span.er { color: #ff0000; font-weight: bold; } /* Error */
+code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
+code > span.cn { color: #880000; } /* Constant */
+code > span.sc { color: #4070a0; } /* SpecialChar */
+code > span.vs { color: #4070a0; } /* VerbatimString */
+code > span.ss { color: #bb6688; } /* SpecialString */
+code > span.im { } /* Import */
+code > span.va { color: #19177c; } /* Variable */
+code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
+code > span.op { color: #666666; } /* Operator */
+code > span.bu { } /* BuiltIn */
+code > span.ex { } /* Extension */
+code > span.pp { color: #bc7a00; } /* Preprocessor */
+code > span.at { color: #7d9029; } /* Attribute */
+code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
+code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
+code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
+code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+</style>
+
+
+
+<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+
+</head>
+
+<body>
+
+
+
+
+<h1 class="title toc-ignore">treespace worked example: Dengue trees</h1>
+<h4 class="author"><em>Michelle Kendall, Thibaut Jombart</em></h4>
+
+
+
+<p>This vignette demonstrates the use of <em>treespace</em> to compare a collection of trees. For this example we use trees inferred from 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997). We include a sample of trees from BEAST (v1.8), as well as creating neighbour-joining (NJ) and maximum-likelihood (ML) trees.</p>
+<div id="loading-treespace-and-data" class="section level2">
+<h2>Loading <em>treespace</em> and data:</h2>
+<p>Load the required packages:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(<span class="st">"treespace"</span>)
+<span class="kw">library</span>(<span class="st">"phangorn"</span>)</code></pre></div>
+<p>Load BEAST trees:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">data</span>(DengueTrees)</code></pre></div>
+<p>We load a random sample of 500 of the trees (from the second half of the posterior) produced using BEAST v1.8 with xml file 4 from Drummond and Rambaut (2007). It uses the standard GTR + Gamma + I substitution model with uncorrelated lognormal-distributed relaxed molecular clock. Each tree has 17 tips.</p>
+<p>For convenience in our initial analysis we will take a random sample of 200 of these trees; sample sizes can be increased later.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">set.seed</span>(<span class="dv">123</span>)
+BEASTtrees <-<span class="st"> </span>DengueTrees[<span class="kw">sample</span>(<span class="dv">1</span>:<span class="kw">length</span>(DengueTrees),<span class="dv">200</span>)]</code></pre></div>
+<p>Load nucleotide sequences:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">data</span>(DengueSeqs)</code></pre></div>
+</div>
+<div id="creating-neighbour-joining-and-maximum-likelihood-trees" class="section level2">
+<h2>Creating neighbour-joining and maximum likelihood trees:</h2>
+<p>Create a neighbour-joining (NJ) tree using the Tamura and Nei (1993) model (see <code>?dist.dna</code> for more information) and root it on the outgroup <code>"D4Thai63"</code>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">makeTree <-<span class="st"> </span>function(x){
+ tree <-<span class="st"> </span><span class="kw">nj</span>(<span class="kw">dist.dna</span>(x, <span class="dt">model =</span> <span class="st">"TN93"</span>))
+ tree <-<span class="st"> </span><span class="kw">root</span>(tree, <span class="dt">resolve.root=</span><span class="ot">TRUE</span>, <span class="dt">outgroup=</span><span class="st">"D4Thai63"</span>)
+ tree
+}
+DnjRooted <-<span class="st"> </span><span class="kw">makeTree</span>(DengueSeqs)
+<span class="kw">plot</span>(DnjRooted)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAAC/VBMVEUAAAABAQECAgIDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFCQkJDQ0NERERFRUVGRkZHR0dISEhJSUlKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVWVlZXV1dYWFhZWVlaWlpbW1tcXFxdXV1eXl5fX19gYGBhYWFiYmJjY2NkZ [...]
+<p>We use <code>boot.phylo</code> to bootstrap the tree:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">Dnjboots <-<span class="st"> </span><span class="kw">boot.phylo</span>(DnjRooted, DengueSeqs, <span class="dt">B=</span><span class="dv">100</span>,
+ makeTree, <span class="dt">trees=</span><span class="ot">TRUE</span>, <span class="dt">rooted=</span><span class="ot">TRUE</span>)
+Dnjboots</code></pre></div>
+<p>and we can plot the tree again, annotating it with the bootstrap clade support values:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plot</span>(DnjRooted)
+<span class="kw">drawSupportOnEdges</span>(Dnjboots$BP)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzde0DM+f4/8NdMpZoualSyXeiyiuQylUQuya2W7LplQyu1ylqX9T1uX9bqWKyzLKJNaBch5Oi2aKWcs26Zz0xMF+EnrZCNsI1Gt7n8/vjsme+cIreI6fn4q8/r8/6859Xs5jmf63BUKhUBAACAduG2dgMAAADQ8hDwAAAAWggBDwAAoIUQ8AAAAFoIAQ8AAKCFEPAAAABaCAEPAACghRDwAAAAWggBDwAAoIUQ8AAAAFoIAQ8AAKCFEPAAAABaCAEPAACghRDwAAAAWggBDwAAoIUQ8AAAAFoIAQ8AAKCFEPAAAABaCAEPAACghRDwAAAAWggBDwAAoIUQ8AAAAFoIAQ8AAKCFEPAAAABaCAEPAACghRDwA [...]
+<p>We create a maximum-likelihood (ML) tree and root it as before:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">Dfit.ini <-<span class="st"> </span><span class="kw">pml</span>(DnjRooted, <span class="kw">as.phyDat</span>(DengueSeqs), <span class="dt">k=</span><span class="dv">4</span>)
+Dfit <-<span class="st"> </span><span class="kw">optim.pml</span>(Dfit.ini, <span class="dt">optNni=</span><span class="ot">TRUE</span>, <span class="dt">optBf=</span><span class="ot">TRUE</span>,
+ <span class="dt">optQ=</span><span class="ot">TRUE</span>, <span class="dt">optGamma=</span><span class="ot">TRUE</span>, <span class="dt">model=</span><span class="st">"GTR"</span>)</code></pre></div>
+<pre><code>## Warning: I unrooted the tree</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># root:</span>
+DfitTreeRooted <-<span class="st"> </span><span class="kw">root</span>(Dfit$tree, <span class="dt">resolve.root=</span><span class="ot">TRUE</span>, <span class="dt">outgroup=</span><span class="st">"D4Thai63"</span>)</code></pre></div>
+<p>View the ML tree:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plot</span>(DfitTreeRooted)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAAC/VBMVEUAAAABAQECAgIDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFCQkJDQ0NERERFRUVGRkZHR0dISEhJSUlKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVWVlZXV1dYWFhZWVlaWlpbW1tcXFxdXV1eXl5fX19gYGBhYWFiYmJjY2NkZ [...]
+<p>Create bootstrap trees:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># bootstrap supports:</span>
+DMLboots <-<span class="st"> </span><span class="kw">bootstrap.pml</span>(Dfit, <span class="dt">optNni=</span><span class="ot">TRUE</span>)
+<span class="co"># root:</span>
+DMLbootsrooted <-<span class="st"> </span><span class="kw">lapply</span>(DMLboots, function(x) <span class="kw">root</span>(x, <span class="dt">resolve.root=</span><span class="ot">TRUE</span>, <span class="dt">outgroup=</span><span class="st">"D4Thai63"</span>))
+<span class="kw">class</span>(DMLbootsrooted) <-<span class="st"> "multiPhylo"</span></code></pre></div>
+<p>Plot the ML tree again, with bootstrap support values:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotBS</span>(DfitTreeRooted, DMLboots, <span class="dt">type=</span><span class="st">"phylogram"</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAADAFBMVEUAAAABAQECAgIDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFCQkJDQ0NERERFRUVGRkZHR0dISEhJSUlKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVWVlZXV1dYWFhZWVlaWlpbW1tcXFxdXV1eXl5fX19gYGBhYWFiYmJjY2NkZ [...]
+</div>
+<div id="using-treespace-to-compare-trees" class="section level2">
+<h2>Using <em>treespace</em> to compare trees</h2>
+<p>We now use the function <code>treespace</code> to find and plot distances between all these trees:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># collect the trees into a single object of class multiPhylo:</span>
+DengueTrees <-<span class="st"> </span><span class="kw">c</span>(BEASTtrees, Dnjboots$trees, DMLbootsrooted,
+ DnjRooted, DfitTreeRooted)
+<span class="kw">class</span>(DengueTrees) <-<span class="st"> "multiPhylo"</span>
+<span class="co"># add tree names:</span>
+<span class="kw">names</span>(DengueTrees)[<span class="dv">1</span>:<span class="dv">200</span>] <-<span class="st"> </span><span class="kw">paste0</span>(<span class="st">"BEAST"</span>,<span class="dv">1</span>:<span class="dv">200</span>)
+<span class="kw">names</span>(DengueTrees)[<span class="dv">201</span>:<span class="dv">300</span>] <-<span class="st"> </span><span class="kw">paste0</span>(<span class="st">"NJ_boots"</span>,<span class="dv">1</span>:<span class="dv">100</span>)
+<span class="kw">names</span>(DengueTrees)[<span class="dv">301</span>:<span class="dv">400</span>] <-<span class="st"> </span><span class="kw">paste0</span>(<span class="st">"ML_boots"</span>,<span class="dv">1</span>:<span class="dv">100</span>)
+<span class="kw">names</span>(DengueTrees)[[<span class="dv">401</span>]] <-<span class="st"> "NJ"</span>
+<span class="kw">names</span>(DengueTrees)[[<span class="dv">402</span>]] <-<span class="st"> "ML"</span>
+<span class="co"># create vector corresponding to tree inference method:</span>
+Dtype <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="st">"BEAST"</span>,<span class="dv">200</span>),<span class="kw">rep</span>(<span class="st">"NJboots"</span>,<span class="dv">100</span>),<span class="kw">rep</span>(<span class="st">"MLboots"</span>,<span class="dv">100</span>),<span class="st">"NJ"</span>,<span class="st">"ML"</span>)
+
+<span class="co"># use treespace to find and project the distances:</span>
+Dscape <-<span class="st"> </span><span class="kw">treespace</span>(DengueTrees, <span class="dt">nf=</span><span class="dv">5</span>)
+
+<span class="co"># simple plot:</span>
+<span class="kw">plotGrovesD3</span>(Dscape$pco, <span class="dt">groups=</span>Dtype)</code></pre></div>
+<div id="htmlwidget-31ea40ecf5020c6dee58" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-31ea40ecf5020c6dee58">{"x":{"data":{"x":[-0.0708699070278181,3.04626735267729,-6.04120457865152,8.71856134115717,0.999199953644328,9.63979429447809,-0.312865806352866,2.48807317050694,0.373334244804181,-1.92934069845349,-0.322692692076508,-0.290603142059808,3.04626735267729,-1.41950482305981,-1.96145413386585,5.1395842986698,1.29342863280819,2.07869029648655,-1.69925872999771,-0.544567598891756,1.64883108360809,2.88109421685932,7.93878 [...]
+<p>The function <code>plotGrovesD3</code> produces interactive d3 plots which enable zooming, moving, tooltip text and legend hovering. We now refine the plot with colour-blind friendly colours (selected using <a href="http://colorbrewer2.org/">ColorBrewer2</a>), bigger points, varying symbols and point opacity to demonstrate the NJ and ML trees, informative legend title and smaller legend width:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">Dcols <-<span class="st"> </span><span class="kw">c</span>(<span class="st">"#1b9e77"</span>,<span class="st">"#d95f02"</span>,<span class="st">"#7570b3"</span>)
+Dmethod <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="st">"BEAST"</span>,<span class="dv">200</span>),<span class="kw">rep</span>(<span class="st">"NJ"</span>,<span class="dv">100</span>),<span class="kw">rep</span>(<span class="st">"ML"</span>,<span class="dv">100</span>),<span class="st">"NJ"</span>,<span class="st">"ML"</span>)
+Dbootstraps <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="st">"replicates"</span>,<span class="dv">400</span>),<span class="st">"NJ"</span>,<span class="st">"ML"</span>)
+Dhighlight <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="dv">1</span>,<span class="dv">400</span>),<span class="dv">2</span>,<span class="dv">2</span>)
+<span class="kw">plotGrovesD3</span>(Dscape$pco,
+ <span class="dt">groups=</span>Dmethod,
+ <span class="dt">colors=</span>Dcols,
+ <span class="dt">col_lab=</span><span class="st">"Tree type"</span>,
+ <span class="dt">size_var=</span>Dhighlight,
+ <span class="dt">size_range =</span> <span class="kw">c</span>(<span class="dv">100</span>,<span class="dv">500</span>),
+ <span class="dt">size_lab=</span><span class="st">""</span>,
+ <span class="dt">symbol_var=</span>Dbootstraps,
+ <span class="dt">symbol_lab=</span><span class="st">""</span>,
+ <span class="dt">point_opacity=</span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="fl">0.4</span>,<span class="dv">400</span>),<span class="dv">1</span>,<span class="dv">1</span>),
+ <span class="dt">legend_width=</span><span class="dv">80</span>)</code></pre></div>
+<div id="htmlwidget-d53dfffeba1258790a38" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-d53dfffeba1258790a38">{"x":{"data":{"x":[-0.0708699070278181,3.04626735267729,-6.04120457865152,8.71856134115717,0.999199953644328,9.63979429447809,-0.312865806352866,2.48807317050694,0.373334244804181,-1.92934069845349,-0.322692692076508,-0.290603142059808,3.04626735267729,-1.41950482305981,-1.96145413386585,5.1395842986698,1.29342863280819,2.07869029648655,-1.69925872999771,-0.544567598891756,1.64883108360809,2.88109421685932,7.93878 [...]
+<p>We can also add tree labels to the plot. Where these overlap, the user can use “drag and drop” to move them around for better visibility.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotGrovesD3</span>(Dscape$pco,
+ <span class="dt">groups=</span>Dmethod,
+ <span class="dt">treeNames =</span> <span class="kw">names</span>(DengueTrees), <span class="co"># add the tree names as labels</span>
+ <span class="dt">colors=</span>Dcols,
+ <span class="dt">col_lab=</span><span class="st">"Tree type"</span>,
+ <span class="dt">size_var=</span>Dhighlight,
+ <span class="dt">size_range =</span> <span class="kw">c</span>(<span class="dv">100</span>,<span class="dv">500</span>),
+ <span class="dt">size_lab=</span><span class="st">""</span>,
+ <span class="dt">symbol_var=</span>Dbootstraps,
+ <span class="dt">symbol_lab=</span><span class="st">""</span>,
+ <span class="dt">point_opacity=</span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="fl">0.4</span>,<span class="dv">400</span>),<span class="dv">1</span>,<span class="dv">1</span>),
+ <span class="dt">legend_width=</span><span class="dv">80</span>)</code></pre></div>
+<div id="htmlwidget-e9b78c5b0e67288ae7d6" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-e9b78c5b0e67288ae7d6">{"x":{"data":{"x":[-0.0708699070278181,3.04626735267729,-6.04120457865152,8.71856134115717,0.999199953644328,9.63979429447809,-0.312865806352866,2.48807317050694,0.373334244804181,-1.92934069845349,-0.322692692076508,-0.290603142059808,3.04626735267729,-1.41950482305981,-1.96145413386585,5.1395842986698,1.29342863280819,2.07869029648655,-1.69925872999771,-0.544567598891756,1.64883108360809,2.88109421685932,7.93878 [...]
+<p>Alternatively, where labels are too cluttered, it may be preferable not to plot them but to make the tree names available as tooltip text instead:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotGrovesD3</span>(Dscape$pco,
+ <span class="dt">groups=</span>Dmethod,
+ <span class="dt">tooltip_text =</span> <span class="kw">names</span>(DengueTrees), <span class="co"># add the tree names as tooltip text</span>
+ <span class="dt">colors=</span>Dcols,
+ <span class="dt">col_lab=</span><span class="st">"Tree type"</span>,
+ <span class="dt">size_var=</span>Dhighlight,
+ <span class="dt">size_range =</span> <span class="kw">c</span>(<span class="dv">100</span>,<span class="dv">500</span>),
+ <span class="dt">size_lab=</span><span class="st">""</span>,
+ <span class="dt">symbol_var=</span>Dbootstraps,
+ <span class="dt">symbol_lab=</span><span class="st">""</span>,
+ <span class="dt">point_opacity=</span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="fl">0.4</span>,<span class="dv">400</span>),<span class="dv">1</span>,<span class="dv">1</span>),
+ <span class="dt">legend_width=</span><span class="dv">80</span>)</code></pre></div>
+<div id="htmlwidget-e9f1297908eefcbc3069" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-e9f1297908eefcbc3069">{"x":{"data":{"x":[-0.0708699070278181,3.04626735267729,-6.04120457865152,8.71856134115717,0.999199953644328,9.63979429447809,-0.312865806352866,2.48807317050694,0.373334244804181,-1.92934069845349,-0.322692692076508,-0.290603142059808,3.04626735267729,-1.41950482305981,-1.96145413386585,5.1395842986698,1.29342863280819,2.07869029648655,-1.69925872999771,-0.544567598891756,1.64883108360809,2.88109421685932,7.93878 [...]
+<p>The scree plot is available as part of the <code>treespace</code> output:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">barplot</span>(Dscape$pco$eig, <span class="dt">col=</span><span class="st">"navy"</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nO3dfZBV9Zng8V+/8NZRsNtZAaW1BaQx9gZ8RxYyshACDlC1kDaOAQaBiLUzKlZpWZiMjs6OmzUoqZgwkohkYNRZREWxBsagC3HUqNFAkAkKqFQ3MIIib9Ko3fT+0RPK6L3KJNj33IfP55/cPr9zL4+ku7/3nHvupaS1tTUBALGUFnoAAODoE3gACEjgASAggQeAgAQeAAISeAAISOABICCBB4CABB4AAhJ4AAhI4AEgIIEHgIAEHgACEngACEjgASAggQeAgAQeAAISeAAISOABICCBB4CABB4AAhJ4AAhI4AEgIIEHgIAEHgACEngACEjgASAggQeAgAQeAAISeAAISOABICCBB4CABB4AAhJ4AAhI4AEgI [...]
+<p>We can also view the plot in 3D:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(rgl)</code></pre></div>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">Dcols3D <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(Dcols[[<span class="dv">1</span>]],<span class="dv">200</span>),<span class="kw">rep</span>(Dcols[[<span class="dv">2</span>]],<span class="dv">100</span>),<span class="kw">rep</span>(Dcols[[<span class="dv">3</span>]],<span class="dv">100</span>),Dcols[[<span class="dv">2</span>]],Dcols[[<span class="dv">3</span>]])
+rgl::<span class="kw">plot3d</span>(Dscape$pco$li[,<span class="dv">1</span>],Dscape$pco$li[,<span class="dv">2</span>],Dscape$pco$li[,<span class="dv">3</span>],
+ <span class="dt">type=</span><span class="st">"s"</span>,
+ <span class="dt">size=</span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="fl">1.5</span>,<span class="dv">400</span>),<span class="dv">3</span>,<span class="dv">3</span>),
+ <span class="dt">col=</span>Dcols3D,
+ <span class="dt">xlab=</span><span class="st">""</span>, <span class="dt">ylab=</span><span class="st">""</span>, <span class="dt">zlab=</span><span class="st">""</span>)</code></pre></div>
+<script>/*
+* Copyright (C) 2009 Apple Inc. All Rights Reserved.
+*
+* Redistribution and use in source and binary forms, with or without
+* modification, are permitted provided that the following conditions
+* are met:
+* 1. Redistributions of source code must retain the above copyright
+* notice, this list of conditions and the following disclaimer.
+* 2. Redistributions in binary form must reproduce the above copyright
+* notice, this list of conditions and the following disclaimer in the
+* documentation and/or other materials provided with the distribution.
+*
+* THIS SOFTWARE IS PROVIDED BY APPLE INC. ``AS IS'' AND ANY
+* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL APPLE INC. OR
+* CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+* EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+* PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
+* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+* Copyright (2016) Duncan Murdoch - fixed CanvasMatrix4.ortho,
+* cleaned up.
+*/
+/*
+CanvasMatrix4 class
+This class implements a 4x4 matrix. It has functions which
+duplicate the functionality of the OpenGL matrix stack and
+glut functions.
+IDL:
+[
+Constructor(in CanvasMatrix4 matrix), // copy passed matrix into new CanvasMatrix4
+Constructor(in sequence<float> array) // create new CanvasMatrix4 with 16 floats (row major)
+Constructor() // create new CanvasMatrix4 with identity matrix
+]
+interface CanvasMatrix4 {
+attribute float m11;
+attribute float m12;
+attribute float m13;
+attribute float m14;
+attribute float m21;
+attribute float m22;
+attribute float m23;
+attribute float m24;
+attribute float m31;
+attribute float m32;
+attribute float m33;
+attribute float m34;
+attribute float m41;
+attribute float m42;
+attribute float m43;
+attribute float m44;
+void load(in CanvasMatrix4 matrix); // copy the values from the passed matrix
+void load(in sequence<float> array); // copy 16 floats into the matrix
+sequence<float> getAsArray(); // return the matrix as an array of 16 floats
+WebGLFloatArray getAsCanvasFloatArray(); // return the matrix as a WebGLFloatArray with 16 values
+void makeIdentity(); // replace the matrix with identity
+void transpose(); // replace the matrix with its transpose
+void invert(); // replace the matrix with its inverse
+void translate(in float x, in float y, in float z); // multiply the matrix by passed translation values on the right
+void scale(in float x, in float y, in float z); // multiply the matrix by passed scale values on the right
+void rotate(in float angle, // multiply the matrix by passed rotation values on the right
+in float x, in float y, in float z); // (angle is in degrees)
+void multRight(in CanvasMatrix matrix); // multiply the matrix by the passed matrix on the right
+void multLeft(in CanvasMatrix matrix); // multiply the matrix by the passed matrix on the left
+void ortho(in float left, in float right, // multiply the matrix by the passed ortho values on the right
+in float bottom, in float top,
+in float near, in float far);
+void frustum(in float left, in float right, // multiply the matrix by the passed frustum values on the right
+in float bottom, in float top,
+in float near, in float far);
+void perspective(in float fovy, in float aspect, // multiply the matrix by the passed perspective values on the right
+in float zNear, in float zFar);
+void lookat(in float eyex, in float eyey, in float eyez, // multiply the matrix by the passed lookat
+in float ctrx, in float ctry, in float ctrz, // values on the right
+in float upx, in float upy, in float upz);
+}
+*/
+CanvasMatrix4 = function(m)
+{
+if (typeof m == 'object') {
+if ("length" in m && m.length >= 16) {
+this.load(m[0], m[1], m[2], m[3], m[4], m[5], m[6], m[7], m[8], m[9], m[10], m[11], m[12], m[13], m[14], m[15]);
+return;
+}
+else if (m instanceof CanvasMatrix4) {
+this.load(m);
+return;
+}
+}
+this.makeIdentity();
+};
+CanvasMatrix4.prototype.load = function()
+{
+if (arguments.length == 1 && typeof arguments[0] == 'object') {
+var matrix = arguments[0];
+if ("length" in matrix && matrix.length == 16) {
+this.m11 = matrix[0];
+this.m12 = matrix[1];
+this.m13 = matrix[2];
+this.m14 = matrix[3];
+this.m21 = matrix[4];
+this.m22 = matrix[5];
+this.m23 = matrix[6];
+this.m24 = matrix[7];
+this.m31 = matrix[8];
+this.m32 = matrix[9];
+this.m33 = matrix[10];
+this.m34 = matrix[11];
+this.m41 = matrix[12];
+this.m42 = matrix[13];
+this.m43 = matrix[14];
+this.m44 = matrix[15];
+return;
+}
+if (arguments[0] instanceof CanvasMatrix4) {
+this.m11 = matrix.m11;
+this.m12 = matrix.m12;
+this.m13 = matrix.m13;
+this.m14 = matrix.m14;
+this.m21 = matrix.m21;
+this.m22 = matrix.m22;
+this.m23 = matrix.m23;
+this.m24 = matrix.m24;
+this.m31 = matrix.m31;
+this.m32 = matrix.m32;
+this.m33 = matrix.m33;
+this.m34 = matrix.m34;
+this.m41 = matrix.m41;
+this.m42 = matrix.m42;
+this.m43 = matrix.m43;
+this.m44 = matrix.m44;
+return;
+}
+}
+this.makeIdentity();
+};
+CanvasMatrix4.prototype.getAsArray = function()
+{
+return [
+this.m11, this.m12, this.m13, this.m14,
+this.m21, this.m22, this.m23, this.m24,
+this.m31, this.m32, this.m33, this.m34,
+this.m41, this.m42, this.m43, this.m44
+];
+};
+CanvasMatrix4.prototype.getAsWebGLFloatArray = function()
+{
+return new WebGLFloatArray(this.getAsArray());
+};
+CanvasMatrix4.prototype.makeIdentity = function()
+{
+this.m11 = 1;
+this.m12 = 0;
+this.m13 = 0;
+this.m14 = 0;
+this.m21 = 0;
+this.m22 = 1;
+this.m23 = 0;
+this.m24 = 0;
+this.m31 = 0;
+this.m32 = 0;
+this.m33 = 1;
+this.m34 = 0;
+this.m41 = 0;
+this.m42 = 0;
+this.m43 = 0;
+this.m44 = 1;
+};
+CanvasMatrix4.prototype.transpose = function()
+{
+var tmp = this.m12;
+this.m12 = this.m21;
+this.m21 = tmp;
+tmp = this.m13;
+this.m13 = this.m31;
+this.m31 = tmp;
+tmp = this.m14;
+this.m14 = this.m41;
+this.m41 = tmp;
+tmp = this.m23;
+this.m23 = this.m32;
+this.m32 = tmp;
+tmp = this.m24;
+this.m24 = this.m42;
+this.m42 = tmp;
+tmp = this.m34;
+this.m34 = this.m43;
+this.m43 = tmp;
+};
+CanvasMatrix4.prototype.invert = function()
+{
+// Calculate the 4x4 determinant
+// If the determinant is zero,
+// then the inverse matrix is not unique.
+var det = this._determinant4x4();
+if (Math.abs(det) < 1e-8)
+return null;
+this._makeAdjoint();
+// Scale the adjoint matrix to get the inverse
+this.m11 /= det;
+this.m12 /= det;
+this.m13 /= det;
+this.m14 /= det;
+this.m21 /= det;
+this.m22 /= det;
+this.m23 /= det;
+this.m24 /= det;
+this.m31 /= det;
+this.m32 /= det;
+this.m33 /= det;
+this.m34 /= det;
+this.m41 /= det;
+this.m42 /= det;
+this.m43 /= det;
+this.m44 /= det;
+};
+CanvasMatrix4.prototype.translate = function(x,y,z)
+{
+if (x === undefined)
+x = 0;
+if (y === undefined)
+y = 0;
+if (z === undefined)
+z = 0;
+var matrix = new CanvasMatrix4();
+matrix.m41 = x;
+matrix.m42 = y;
+matrix.m43 = z;
+this.multRight(matrix);
+};
+CanvasMatrix4.prototype.scale = function(x,y,z)
+{
+if (x === undefined)
+x = 1;
+if (z === undefined) {
+if (y === undefined) {
+y = x;
+z = x;
+}
+else
+z = 1;
+}
+else if (y === undefined)
+y = x;
+var matrix = new CanvasMatrix4();
+matrix.m11 = x;
+matrix.m22 = y;
+matrix.m33 = z;
+this.multRight(matrix);
+};
+CanvasMatrix4.prototype.rotate = function(angle,x,y,z)
+{
+// angles are in degrees. Switch to radians
+angle = angle / 180 * Math.PI;
+angle /= 2;
+var sinA = Math.sin(angle);
+var cosA = Math.cos(angle);
+var sinA2 = sinA * sinA;
+// normalize
+var length = Math.sqrt(x * x + y * y + z * z);
+if (length === 0) {
+// bad vector, just use something reasonable
+x = 0;
+y = 0;
+z = 1;
+} else if (length != 1) {
+x /= length;
+y /= length;
+z /= length;
+}
+var mat = new CanvasMatrix4();
+// optimize case where axis is along major axis
+if (x == 1 && y === 0 && z === 0) {
+mat.m11 = 1;
+mat.m12 = 0;
+mat.m13 = 0;
+mat.m21 = 0;
+mat.m22 = 1 - 2 * sinA2;
+mat.m23 = 2 * sinA * cosA;
+mat.m31 = 0;
+mat.m32 = -2 * sinA * cosA;
+mat.m33 = 1 - 2 * sinA2;
+mat.m14 = mat.m24 = mat.m34 = 0;
+mat.m41 = mat.m42 = mat.m43 = 0;
+mat.m44 = 1;
+} else if (x === 0 && y == 1 && z === 0) {
+mat.m11 = 1 - 2 * sinA2;
+mat.m12 = 0;
+mat.m13 = -2 * sinA * cosA;
+mat.m21 = 0;
+mat.m22 = 1;
+mat.m23 = 0;
+mat.m31 = 2 * sinA * cosA;
+mat.m32 = 0;
+mat.m33 = 1 - 2 * sinA2;
+mat.m14 = mat.m24 = mat.m34 = 0;
+mat.m41 = mat.m42 = mat.m43 = 0;
+mat.m44 = 1;
+} else if (x === 0 && y === 0 && z == 1) {
+mat.m11 = 1 - 2 * sinA2;
+mat.m12 = 2 * sinA * cosA;
+mat.m13 = 0;
+mat.m21 = -2 * sinA * cosA;
+mat.m22 = 1 - 2 * sinA2;
+mat.m23 = 0;
+mat.m31 = 0;
+mat.m32 = 0;
+mat.m33 = 1;
+mat.m14 = mat.m24 = mat.m34 = 0;
+mat.m41 = mat.m42 = mat.m43 = 0;
+mat.m44 = 1;
+} else {
+var x2 = x*x;
+var y2 = y*y;
+var z2 = z*z;
+mat.m11 = 1 - 2 * (y2 + z2) * sinA2;
+mat.m12 = 2 * (x * y * sinA2 + z * sinA * cosA);
+mat.m13 = 2 * (x * z * sinA2 - y * sinA * cosA);
+mat.m21 = 2 * (y * x * sinA2 - z * sinA * cosA);
+mat.m22 = 1 - 2 * (z2 + x2) * sinA2;
+mat.m23 = 2 * (y * z * sinA2 + x * sinA * cosA);
+mat.m31 = 2 * (z * x * sinA2 + y * sinA * cosA);
+mat.m32 = 2 * (z * y * sinA2 - x * sinA * cosA);
+mat.m33 = 1 - 2 * (x2 + y2) * sinA2;
+mat.m14 = mat.m24 = mat.m34 = 0;
+mat.m41 = mat.m42 = mat.m43 = 0;
+mat.m44 = 1;
+}
+this.multRight(mat);
+};
+CanvasMatrix4.prototype.multRight = function(mat)
+{
+var m11 = (this.m11 * mat.m11 + this.m12 * mat.m21 +
+this.m13 * mat.m31 + this.m14 * mat.m41);
+var m12 = (this.m11 * mat.m12 + this.m12 * mat.m22 +
+this.m13 * mat.m32 + this.m14 * mat.m42);
+var m13 = (this.m11 * mat.m13 + this.m12 * mat.m23 +
+this.m13 * mat.m33 + this.m14 * mat.m43);
+var m14 = (this.m11 * mat.m14 + this.m12 * mat.m24 +
+this.m13 * mat.m34 + this.m14 * mat.m44);
+var m21 = (this.m21 * mat.m11 + this.m22 * mat.m21 +
+this.m23 * mat.m31 + this.m24 * mat.m41);
+var m22 = (this.m21 * mat.m12 + this.m22 * mat.m22 +
+this.m23 * mat.m32 + this.m24 * mat.m42);
+var m23 = (this.m21 * mat.m13 + this.m22 * mat.m23 +
+this.m23 * mat.m33 + this.m24 * mat.m43);
+var m24 = (this.m21 * mat.m14 + this.m22 * mat.m24 +
+this.m23 * mat.m34 + this.m24 * mat.m44);
+var m31 = (this.m31 * mat.m11 + this.m32 * mat.m21 +
+this.m33 * mat.m31 + this.m34 * mat.m41);
+var m32 = (this.m31 * mat.m12 + this.m32 * mat.m22 +
+this.m33 * mat.m32 + this.m34 * mat.m42);
+var m33 = (this.m31 * mat.m13 + this.m32 * mat.m23 +
+this.m33 * mat.m33 + this.m34 * mat.m43);
+var m34 = (this.m31 * mat.m14 + this.m32 * mat.m24 +
+this.m33 * mat.m34 + this.m34 * mat.m44);
+var m41 = (this.m41 * mat.m11 + this.m42 * mat.m21 +
+this.m43 * mat.m31 + this.m44 * mat.m41);
+var m42 = (this.m41 * mat.m12 + this.m42 * mat.m22 +
+this.m43 * mat.m32 + this.m44 * mat.m42);
+var m43 = (this.m41 * mat.m13 + this.m42 * mat.m23 +
+this.m43 * mat.m33 + this.m44 * mat.m43);
+var m44 = (this.m41 * mat.m14 + this.m42 * mat.m24 +
+this.m43 * mat.m34 + this.m44 * mat.m44);
+this.m11 = m11;
+this.m12 = m12;
+this.m13 = m13;
+this.m14 = m14;
+this.m21 = m21;
+this.m22 = m22;
+this.m23 = m23;
+this.m24 = m24;
+this.m31 = m31;
+this.m32 = m32;
+this.m33 = m33;
+this.m34 = m34;
+this.m41 = m41;
+this.m42 = m42;
+this.m43 = m43;
+this.m44 = m44;
+};
+CanvasMatrix4.prototype.multLeft = function(mat)
+{
+var m11 = (mat.m11 * this.m11 + mat.m12 * this.m21 +
+mat.m13 * this.m31 + mat.m14 * this.m41);
+var m12 = (mat.m11 * this.m12 + mat.m12 * this.m22 +
+mat.m13 * this.m32 + mat.m14 * this.m42);
+var m13 = (mat.m11 * this.m13 + mat.m12 * this.m23 +
+mat.m13 * this.m33 + mat.m14 * this.m43);
+var m14 = (mat.m11 * this.m14 + mat.m12 * this.m24 +
+mat.m13 * this.m34 + mat.m14 * this.m44);
+var m21 = (mat.m21 * this.m11 + mat.m22 * this.m21 +
+mat.m23 * this.m31 + mat.m24 * this.m41);
+var m22 = (mat.m21 * this.m12 + mat.m22 * this.m22 +
+mat.m23 * this.m32 + mat.m24 * this.m42);
+var m23 = (mat.m21 * this.m13 + mat.m22 * this.m23 +
+mat.m23 * this.m33 + mat.m24 * this.m43);
+var m24 = (mat.m21 * this.m14 + mat.m22 * this.m24 +
+mat.m23 * this.m34 + mat.m24 * this.m44);
+var m31 = (mat.m31 * this.m11 + mat.m32 * this.m21 +
+mat.m33 * this.m31 + mat.m34 * this.m41);
+var m32 = (mat.m31 * this.m12 + mat.m32 * this.m22 +
+mat.m33 * this.m32 + mat.m34 * this.m42);
+var m33 = (mat.m31 * this.m13 + mat.m32 * this.m23 +
+mat.m33 * this.m33 + mat.m34 * this.m43);
+var m34 = (mat.m31 * this.m14 + mat.m32 * this.m24 +
+mat.m33 * this.m34 + mat.m34 * this.m44);
+var m41 = (mat.m41 * this.m11 + mat.m42 * this.m21 +
+mat.m43 * this.m31 + mat.m44 * this.m41);
+var m42 = (mat.m41 * this.m12 + mat.m42 * this.m22 +
+mat.m43 * this.m32 + mat.m44 * this.m42);
+var m43 = (mat.m41 * this.m13 + mat.m42 * this.m23 +
+mat.m43 * this.m33 + mat.m44 * this.m43);
+var m44 = (mat.m41 * this.m14 + mat.m42 * this.m24 +
+mat.m43 * this.m34 + mat.m44 * this.m44);
+this.m11 = m11;
+this.m12 = m12;
+this.m13 = m13;
+this.m14 = m14;
+this.m21 = m21;
+this.m22 = m22;
+this.m23 = m23;
+this.m24 = m24;
+this.m31 = m31;
+this.m32 = m32;
+this.m33 = m33;
+this.m34 = m34;
+this.m41 = m41;
+this.m42 = m42;
+this.m43 = m43;
+this.m44 = m44;
+};
+CanvasMatrix4.prototype.ortho = function(left, right, bottom, top, near, far)
+{
+var tx = (left + right) / (left - right);
+var ty = (top + bottom) / (bottom - top);
+var tz = (far + near) / (near - far);
+var matrix = new CanvasMatrix4();
+matrix.m11 = 2 / (right - left);
+matrix.m12 = 0;
+matrix.m13 = 0;
+matrix.m14 = 0;
+matrix.m21 = 0;
+matrix.m22 = 2 / (top - bottom);
+matrix.m23 = 0;
+matrix.m24 = 0;
+matrix.m31 = 0;
+matrix.m32 = 0;
+matrix.m33 = -2 / (far - near);
+matrix.m34 = 0;
+matrix.m41 = tx;
+matrix.m42 = ty;
+matrix.m43 = tz;
+matrix.m44 = 1;
+this.multRight(matrix);
+};
+CanvasMatrix4.prototype.frustum = function(left, right, bottom, top, near, far)
+{
+var matrix = new CanvasMatrix4();
+var A = (right + left) / (right - left);
+var B = (top + bottom) / (top - bottom);
+var C = -(far + near) / (far - near);
+var D = -(2 * far * near) / (far - near);
+matrix.m11 = (2 * near) / (right - left);
+matrix.m12 = 0;
+matrix.m13 = 0;
+matrix.m14 = 0;
+matrix.m21 = 0;
+matrix.m22 = 2 * near / (top - bottom);
+matrix.m23 = 0;
+matrix.m24 = 0;
+matrix.m31 = A;
+matrix.m32 = B;
+matrix.m33 = C;
+matrix.m34 = -1;
+matrix.m41 = 0;
+matrix.m42 = 0;
+matrix.m43 = D;
+matrix.m44 = 0;
+this.multRight(matrix);
+};
+CanvasMatrix4.prototype.perspective = function(fovy, aspect, zNear, zFar)
+{
+var top = Math.tan(fovy * Math.PI / 360) * zNear;
+var bottom = -top;
+var left = aspect * bottom;
+var right = aspect * top;
+this.frustum(left, right, bottom, top, zNear, zFar);
+};
+CanvasMatrix4.prototype.lookat = function(eyex, eyey, eyez, centerx, centery, centerz, upx, upy, upz)
+{
+var matrix = new CanvasMatrix4();
+// Make rotation matrix
+// Z vector
+var zx = eyex - centerx;
+var zy = eyey - centery;
+var zz = eyez - centerz;
+var mag = Math.sqrt(zx * zx + zy * zy + zz * zz);
+if (mag) {
+zx /= mag;
+zy /= mag;
+zz /= mag;
+}
+// Y vector
+var yx = upx;
+var yy = upy;
+var yz = upz;
+// X vector = Y cross Z
+xx = yy * zz - yz * zy;
+xy = -yx * zz + yz * zx;
+xz = yx * zy - yy * zx;
+// Recompute Y = Z cross X
+yx = zy * xz - zz * xy;
+yy = -zx * xz + zz * xx;
+yx = zx * xy - zy * xx;
+// cross product gives area of parallelogram, which is < 1.0 for
+// non-perpendicular unit-length vectors; so normalize x, y here
+mag = Math.sqrt(xx * xx + xy * xy + xz * xz);
+if (mag) {
+xx /= mag;
+xy /= mag;
+xz /= mag;
+}
+mag = Math.sqrt(yx * yx + yy * yy + yz * yz);
+if (mag) {
+yx /= mag;
+yy /= mag;
+yz /= mag;
+}
+matrix.m11 = xx;
+matrix.m12 = xy;
+matrix.m13 = xz;
+matrix.m14 = 0;
+matrix.m21 = yx;
+matrix.m22 = yy;
+matrix.m23 = yz;
+matrix.m24 = 0;
+matrix.m31 = zx;
+matrix.m32 = zy;
+matrix.m33 = zz;
+matrix.m34 = 0;
+matrix.m41 = 0;
+matrix.m42 = 0;
+matrix.m43 = 0;
+matrix.m44 = 1;
+matrix.translate(-eyex, -eyey, -eyez);
+this.multRight(matrix);
+};
+// Support functions
+CanvasMatrix4.prototype._determinant2x2 = function(a, b, c, d)
+{
+return a * d - b * c;
+};
+CanvasMatrix4.prototype._determinant3x3 = function(a1, a2, a3, b1, b2, b3, c1, c2, c3)
+{
+return a1 * this._determinant2x2(b2, b3, c2, c3) -
+b1 * this._determinant2x2(a2, a3, c2, c3) +
+c1 * this._determinant2x2(a2, a3, b2, b3);
+};
+CanvasMatrix4.prototype._determinant4x4 = function()
+{
+var a1 = this.m11;
+var b1 = this.m12;
+var c1 = this.m13;
+var d1 = this.m14;
+var a2 = this.m21;
+var b2 = this.m22;
+var c2 = this.m23;
+var d2 = this.m24;
+var a3 = this.m31;
+var b3 = this.m32;
+var c3 = this.m33;
+var d3 = this.m34;
+var a4 = this.m41;
+var b4 = this.m42;
+var c4 = this.m43;
+var d4 = this.m44;
+return a1 * this._determinant3x3(b2, b3, b4, c2, c3, c4, d2, d3, d4) -
+b1 * this._determinant3x3(a2, a3, a4, c2, c3, c4, d2, d3, d4) +
+c1 * this._determinant3x3(a2, a3, a4, b2, b3, b4, d2, d3, d4) -
+d1 * this._determinant3x3(a2, a3, a4, b2, b3, b4, c2, c3, c4);
+};
+CanvasMatrix4.prototype._makeAdjoint = function()
+{
+var a1 = this.m11;
+var b1 = this.m12;
+var c1 = this.m13;
+var d1 = this.m14;
+var a2 = this.m21;
+var b2 = this.m22;
+var c2 = this.m23;
+var d2 = this.m24;
+var a3 = this.m31;
+var b3 = this.m32;
+var c3 = this.m33;
+var d3 = this.m34;
+var a4 = this.m41;
+var b4 = this.m42;
+var c4 = this.m43;
+var d4 = this.m44;
+// Row column labeling reversed since we transpose rows & columns
+this.m11 = this._determinant3x3(b2, b3, b4, c2, c3, c4, d2, d3, d4);
+this.m21 = - this._determinant3x3(a2, a3, a4, c2, c3, c4, d2, d3, d4);
+this.m31 = this._determinant3x3(a2, a3, a4, b2, b3, b4, d2, d3, d4);
+this.m41 = - this._determinant3x3(a2, a3, a4, b2, b3, b4, c2, c3, c4);
+this.m12 = - this._determinant3x3(b1, b3, b4, c1, c3, c4, d1, d3, d4);
+this.m22 = this._determinant3x3(a1, a3, a4, c1, c3, c4, d1, d3, d4);
+this.m32 = - this._determinant3x3(a1, a3, a4, b1, b3, b4, d1, d3, d4);
+this.m42 = this._determinant3x3(a1, a3, a4, b1, b3, b4, c1, c3, c4);
+this.m13 = this._determinant3x3(b1, b2, b4, c1, c2, c4, d1, d2, d4);
+this.m23 = - this._determinant3x3(a1, a2, a4, c1, c2, c4, d1, d2, d4);
+this.m33 = this._determinant3x3(a1, a2, a4, b1, b2, b4, d1, d2, d4);
+this.m43 = - this._determinant3x3(a1, a2, a4, b1, b2, b4, c1, c2, c4);
+this.m14 = - this._determinant3x3(b1, b2, b3, c1, c2, c3, d1, d2, d3);
+this.m24 = this._determinant3x3(a1, a2, a3, c1, c2, c3, d1, d2, d3);
+this.m34 = - this._determinant3x3(a1, a2, a3, b1, b2, b3, d1, d2, d3);
+this.m44 = this._determinant3x3(a1, a2, a3, b1, b2, b3, c1, c2, c3);
+};</script>
+<script>
+rglwidgetClass = function() {
+this.canvas = null;
+this.userMatrix = new CanvasMatrix4();
+this.types = [];
+this.prMatrix = new CanvasMatrix4();
+this.mvMatrix = new CanvasMatrix4();
+this.vp = null;
+this.prmvMatrix = null;
+this.origs = null;
+this.gl = null;
+this.scene = null;
+};
+(function() {
+this.multMV = function(M, v) {
+return [ M.m11 * v[0] + M.m12 * v[1] + M.m13 * v[2] + M.m14 * v[3],
+M.m21 * v[0] + M.m22 * v[1] + M.m23 * v[2] + M.m24 * v[3],
+M.m31 * v[0] + M.m32 * v[1] + M.m33 * v[2] + M.m34 * v[3],
+M.m41 * v[0] + M.m42 * v[1] + M.m43 * v[2] + M.m44 * v[3]
+];
+};
+this.vlen = function(v) {
+return Math.sqrt(this.dotprod(v, v));
+};
+this.dotprod = function(a, b) {
+return a[0]*b[0] + a[1]*b[1] + a[2]*b[2];
+};
+this.xprod = function(a, b) {
+return [a[1]*b[2] - a[2]*b[1],
+a[2]*b[0] - a[0]*b[2],
+a[0]*b[1] - a[1]*b[0]];
+};
+this.cbind = function(a, b) {
+if (b.length < a.length)
+b = this.repeatToLen(b, a.length);
+else if (a.length < b.length)
+a = this.repeatToLen(a, b.length);
+return a.map(function(currentValue, index, array) {
+return currentValue.concat(b[index]);
+});
+};
+this.swap = function(a, i, j) {
+var temp = a[i];
+a[i] = a[j];
+a[j] = temp;
+};
+this.flatten = function(a) {
+return [].concat.apply([], a);
+};
+/* set element of 1d or 2d array as if it was flattened. Column major, zero based! */
+this.setElement = function(a, i, value) {
+if (Array.isArray(a[0])) {
+var dim = a.length,
+col = Math.floor(i/dim),
+row = i % dim;
+a[row][col] = value;
+} else {
+a[i] = value;
+}
+};
+this.transpose = function(a) {
+var newArray = [],
+n = a.length,
+m = a[0].length,
+i;
+for(i = 0; i < m; i++){
+newArray.push([]);
+}
+for(i = 0; i < n; i++){
+for(var j = 0; j < m; j++){
+newArray[j].push(a[i][j]);
+}
+}
+return newArray;
+};
+this.sumsq = function(x) {
+var result = 0, i;
+for (i=0; i < x.length; i++)
+result += x[i]*x[i];
+return result;
+};
+this.toCanvasMatrix4 = function(mat) {
+if (mat instanceof CanvasMatrix4)
+return mat;
+var result = new CanvasMatrix4();
+mat = this.flatten(this.transpose(mat));
+result.load(mat);
+return result;
+};
+this.stringToRgb = function(s) {
+s = s.replace("#", "");
+var bigint = parseInt(s, 16);
+return [((bigint >> 16) & 255)/255,
+((bigint >> 8) & 255)/255,
+(bigint & 255)/255];
+};
+this.componentProduct = function(x, y) {
+if (typeof y === "undefined") {
+this.alertOnce("Bad arg to componentProduct");
+}
+var result = new Float32Array(3), i;
+for (i = 0; i<3; i++)
+result[i] = x[i]*y[i];
+return result;
+};
+this.getPowerOfTwo = function(value) {
+var pow = 1;
+while(pow<value) {
+pow *= 2;
+}
+return pow;
+};
+this.unique = function(arr) {
+arr = [].concat(arr);
+return arr.filter(function(value, index, self) {
+return self.indexOf(value) === index;
+});
+};
+this.repeatToLen = function(arr, len) {
+arr = [].concat(arr);
+while (arr.length < len/2)
+arr = arr.concat(arr);
+return arr.concat(arr.slice(0, len - arr.length));
+};
+this.alertOnce = function(msg) {
+if (typeof this.alerted !== "undefined")
+return;
+this.alerted = true;
+alert(msg);
+};
+this.f_is_lit = 1;
+this.f_is_smooth = 2;
+this.f_has_texture = 4;
+this.f_is_indexed = 8;
+this.f_depth_sort = 16;
+this.f_fixed_quads = 32;
+this.f_is_transparent = 64;
+this.f_is_lines = 128;
+this.f_sprites_3d = 256;
+this.f_sprite_3d = 512;
+this.f_is_subscene = 1024;
+this.f_is_clipplanes = 2048;
+this.f_fixed_size = 4096;
+this.f_is_points = 8192;
+this.f_is_twosided = 16384;
+this.whichList = function(id) {
+var obj = this.getObj(id),
+flags = obj.flags;
+if (obj.type === "light")
+return "lights";
+if (flags & this.f_is_subscene)
+return "subscenes";
+if (flags & this.f_is_clipplanes)
+return "clipplanes";
+if (flags & this.f_is_transparent)
+return "transparent";
+return "opaque";
+};
+this.getObj = function(id) {
+if (typeof id !== "number") {
+this.alertOnce("getObj id is "+typeof id);
+}
+return this.scene.objects[id];
+};
+this.getIdsByType = function(type, subscene) {
+var
+result = [], i, self = this;
+if (typeof subscene === "undefined") {
+Object.keys(this.scene.objects).forEach(
+function(key) {
+key = parseInt(key, 10);
+if (self.getObj(key).type === type)
+result.push(key);
+});
+} else {
+ids = this.getObj(subscene).objects;
+for (i=0; i < ids.length; i++) {
+if (this.getObj(ids[i]).type === type) {
+result.push(ids[i]);
+}
+}
+}
+return result;
+};
+this.getMaterial = function(id, property) {
+var obj = this.getObj(id),
+mat = obj.material[property];
+if (typeof mat === "undefined")
+mat = this.scene.material[property];
+return mat;
+};
+this.inSubscene = function(id, subscene) {
+return this.getObj(subscene).objects.indexOf(id) > -1;
+};
+this.addToSubscene = function(id, subscene) {
+var thelist,
+thesub = this.getObj(subscene),
+ids = [id],
+obj = this.getObj(id), i;
+if (typeof obj.newIds !== "undefined") {
+ids = ids.concat(obj.newIds);
+}
+for (i = 0; i < ids.length; i++) {
+id = ids[i];
+if (thesub.objects.indexOf(id) == -1) {
+thelist = this.whichList(id);
+thesub.objects.push(id);
+thesub[thelist].push(id);
+}
+}
+};
+this.delFromSubscene = function(id, subscene) {
+var thelist,
+thesub = this.getObj(subscene),
+obj = this.getObj(id),
+ids = [id], i;
+if (typeof obj.newIds !== "undefined")
+ids = ids.concat(obj.newIds);
+for (j=0; j<ids.length;j++) {
+id = ids[j];
+i = thesub.objects.indexOf(id);
+if (i > -1) {
+thesub.objects.splice(i, 1);
+thelist = this.whichList(id);
+i = thesub[thelist].indexOf(id);
+thesub[thelist].splice(i, 1);
+}
+}
+};
+this.setSubsceneEntries = function(ids, subsceneid) {
+var sub = this.getObj(subsceneid);
+sub.objects = ids;
+this.initSubscene(subsceneid);
+};
+this.getSubsceneEntries = function(subscene) {
+return this.getObj(subscene).objects;
+};
+this.getChildSubscenes = function(subscene) {
+return this.getObj(subscene).subscenes;
+};
+this.startDrawing = function() {
+var value = this.drawing;
+this.drawing = true;
+return value;
+};
+this.stopDrawing = function(saved) {
+this.drawing = saved;
+if (!saved && this.gl && this.gl.isContextLost())
+this.restartCanvas();
+};
+this.getVertexShader = function(id) {
+var obj = this.getObj(id),
+userShader = obj.userVertexShader,
+flags = obj.flags,
+type = obj.type,
+is_lit = flags & this.f_is_lit,
+has_texture = flags & this.f_has_texture,
+fixed_quads = flags & this.f_fixed_quads,
+sprites_3d = flags & this.f_sprites_3d,
+sprite_3d = flags & this.f_sprite_3d,
+nclipplanes = this.countClipplanes(),
+fixed_size = flags & this.f_fixed_size,
+is_points = flags & this.f_is_points,
+is_twosided = flags & this.f_is_twosided,
+result;
+if (type === "clipplanes" || sprites_3d) return;
+if (typeof userShader !== "undefined") return userShader;
+result = " /* ****** "+type+" object "+id+" vertex shader ****** */\n"+
+" attribute vec3 aPos;\n"+
+" attribute vec4 aCol;\n"+
+" uniform mat4 mvMatrix;\n"+
+" uniform mat4 prMatrix;\n"+
+" varying vec4 vCol;\n"+
+" varying vec4 vPosition;\n";
+if ((is_lit && !fixed_quads) || sprite_3d)
+result = result + " attribute vec3 aNorm;\n"+
+" uniform mat4 normMatrix;\n"+
+" varying vec3 vNormal;\n";
+if (has_texture || type === "text")
+result = result + " attribute vec2 aTexcoord;\n"+
+" varying vec2 vTexcoord;\n";
+if (fixed_size)
+result = result + " uniform vec2 textScale;\n";
+if (fixed_quads)
+result = result + " attribute vec2 aOfs;\n";
+else if (sprite_3d)
+result = result + " uniform vec3 uOrig;\n"+
+" uniform float uSize;\n"+
+" uniform mat4 usermat;\n";
+if (is_twosided)
+result = result + " attribute vec3 aPos1;\n"+
+" attribute vec3 aPos2;\n"+
+" varying float normz;\n";
+result = result + " void main(void) {\n";
+if (nclipplanes || (!fixed_quads && !sprite_3d))
+result = result + " vPosition = mvMatrix * vec4(aPos, 1.);\n";
+if (!fixed_quads && !sprite_3d)
+result = result + " gl_Position = prMatrix * vPosition;\n";
+if (is_points) {
+var size = this.getMaterial(id, "size");
+result = result + " gl_PointSize = "+size.toFixed(1)+";\n";
+}
+result = result + " vCol = aCol;\n";
+if (is_lit && !fixed_quads && !sprite_3d)
+result = result + " vNormal = normalize((normMatrix * vec4(aNorm, 1.)).xyz);\n";
+if (has_texture || type == "text")
+result = result + " vTexcoord = aTexcoord;\n";
+if (fixed_size)
+result = result + " vec4 pos = prMatrix * mvMatrix * vec4(aPos, 1.);\n"+
+" pos = pos/pos.w;\n"+
+" gl_Position = pos + vec4(aOfs*textScale, 0.,0.);\n";
+if (type == "sprites" && !fixed_size)
+result = result + " vec4 pos = mvMatrix * vec4(aPos, 1.);\n"+
+" pos = pos/pos.w + vec4(aOfs, 0., 0.);\n"+
+" gl_Position = prMatrix*pos;\n";
+if (sprite_3d)
+result = result + " vNormal = normalize((normMatrix * vec4(aNorm, 1.)).xyz);\n"+
+" vec4 pos = mvMatrix * vec4(uOrig, 1.);\n"+
+" vPosition = pos/pos.w + vec4(uSize*(vec4(aPos, 1.)*usermat).xyz,0.);\n"+
+" gl_Position = prMatrix * vPosition;\n";
+if (is_twosided)
+result = result + " vec4 pos1 = prMatrix*(mvMatrix*vec4(aPos1, 1.));\n"+
+" pos1 = pos1/pos1.w - gl_Position/gl_Position.w;\n"+
+" vec4 pos2 = prMatrix*(mvMatrix*vec4(aPos2, 1.));\n"+
+" pos2 = pos2/pos2.w - gl_Position/gl_Position.w;\n"+
+" normz = pos1.x*pos2.y - pos1.y*pos2.x;\n";
+result = result + " }\n";
+// console.log(result);
+return result;
+};
+this.getFragmentShader = function(id) {
+var obj = this.getObj(id),
+userShader = obj.userFragmentShader,
+flags = obj.flags,
+type = obj.type,
+is_lit = flags & this.f_is_lit,
+has_texture = flags & this.f_has_texture,
+fixed_quads = flags & this.f_fixed_quads,
+sprites_3d = flags & this.f_sprites_3d,
+is_twosided = (flags & this.f_is_twosided) > 0,
+nclipplanes = this.countClipplanes(), i,
+texture_format, nlights,
+result;
+if (type === "clipplanes" || sprites_3d) return;
+if (typeof userShader !== "undefined") return userShader;
+if (has_texture)
+texture_format = this.getMaterial(id, "textype");
+result = "/* ****** "+type+" object "+id+" fragment shader ****** */\n"+
+"#ifdef GL_ES\n"+
+" precision highp float;\n"+
+"#endif\n"+
+" varying vec4 vCol; // carries alpha\n"+
+" varying vec4 vPosition;\n";
+if (has_texture || type === "text")
+result = result + " varying vec2 vTexcoord;\n"+
+" uniform sampler2D uSampler;\n";
+if (is_lit && !fixed_quads)
+result = result + " varying vec3 vNormal;\n";
+for (i = 0; i < nclipplanes; i++)
+result = result + " uniform vec4 vClipplane"+i+";\n";
+if (is_lit) {
+nlights = this.countLights();
+if (nlights)
+result = result + " uniform mat4 mvMatrix;\n";
+else
+is_lit = false;
+}
+if (is_lit) {
+result = result + " uniform vec3 emission;\n"+
+" uniform float shininess;\n";
+for (i=0; i < nlights; i++) {
+result = result + " uniform vec3 ambient" + i + ";\n"+
+" uniform vec3 specular" + i +"; // light*material\n"+
+" uniform vec3 diffuse" + i + ";\n"+
+" uniform vec3 lightDir" + i + ";\n"+
+" uniform bool viewpoint" + i + ";\n"+
+" uniform bool finite" + i + ";\n";
+}
+}
+if (is_twosided)
+result = result + " uniform bool front;\n"+
+" varying float normz;\n";
+result = result + " void main(void) {\n";
+for (i=0; i < nclipplanes;i++)
+result = result + " if (dot(vPosition, vClipplane"+i+") < 0.0) discard;\n";
+if (fixed_quads) {
+result = result + " vec3 n = vec3(0., 0., 1.);\n";
+} else if (is_lit) {
+result = result + " vec3 n = normalize(vNormal);\n";
+}
+if (is_twosided) {
+result = result + " if ((normz <= 0.) != front) discard;";
+}
+if (is_lit) {
+result = result + " vec3 eye = normalize(-vPosition.xyz);\n"+
+" vec3 lightdir;\n"+
+" vec4 colDiff;\n"+
+" vec3 halfVec;\n"+
+" vec4 lighteffect = vec4(emission, 0.);\n"+
+" vec3 col;\n"+
+" float nDotL;\n";
+if (!fixed_quads) {
+result = result + " n = -faceforward(n, n, eye);\n";
+}
+for (i=0; i < nlights; i++) {
+result = result + " colDiff = vec4(vCol.rgb * diffuse" + i + ", vCol.a);\n"+
+" lightdir = lightDir" + i + ";\n"+
+" if (!viewpoint" + i +")\n"+
+" lightdir = (mvMatrix * vec4(lightdir, 1.)).xyz;\n"+
+" if (!finite" + i + ") {\n"+
+" halfVec = normalize(lightdir + eye);\n"+
+" } else {\n"+
+" lightdir = normalize(lightdir - vPosition.xyz);\n"+
+" halfVec = normalize(lightdir + eye);\n"+
+" }\n"+
+" col = ambient" + i + ";\n"+
+" nDotL = dot(n, lightdir);\n"+
+" col = col + max(nDotL, 0.) * colDiff.rgb;\n"+
+" col = col + pow(max(dot(halfVec, n), 0.), shininess) * specular" + i + ";\n"+
+" lighteffect = lighteffect + vec4(col, colDiff.a);\n";
+}
+} else {
+result = result + " vec4 colDiff = vCol;\n"+
+" vec4 lighteffect = colDiff;\n";
+}
+if (type === "text")
+result = result + " vec4 textureColor = lighteffect*texture2D(uSampler, vTexcoord);\n";
+if (has_texture) {
+result = result + {
+rgb: " vec4 textureColor = lighteffect*vec4(texture2D(uSampler, vTexcoord).rgb, 1.);\n",
+rgba: " vec4 textureColor = lighteffect*texture2D(uSampler, vTexcoord);\n",
+alpha: " vec4 textureColor = texture2D(uSampler, vTexcoord);\n"+
+" float luminance = dot(vec3(1.,1.,1.), textureColor.rgb)/3.;\n"+
+" textureColor = vec4(lighteffect.rgb, lighteffect.a*luminance);\n",
+luminance: " vec4 textureColor = vec4(lighteffect.rgb*dot(texture2D(uSampler, vTexcoord).rgb, vec3(1.,1.,1.))/3., lighteffect.a);\n",
+"luminance.alpha":" vec4 textureColor = texture2D(uSampler, vTexcoord);\n"+
+" float luminance = dot(vec3(1.,1.,1.),textureColor.rgb)/3.;\n"+
+" textureColor = vec4(lighteffect.rgb*luminance, lighteffect.a*textureColor.a);\n"
+}[texture_format]+
+" gl_FragColor = textureColor;\n";
+} else if (type === "text") {
+result = result + " if (textureColor.a < 0.1)\n"+
+" discard;\n"+
+" else\n"+
+" gl_FragColor = textureColor;\n";
+} else
+result = result + " gl_FragColor = lighteffect;\n";
+result = result + " }\n";
+// console.log(result);
+return result;
+};
+this.getShader = function(shaderType, code) {
+var gl = this.gl, shader;
+shader = gl.createShader(shaderType);
+gl.shaderSource(shader, code);
+gl.compileShader(shader);
+if (!gl.getShaderParameter(shader, gl.COMPILE_STATUS) && !gl.isContextLost())
+alert(gl.getShaderInfoLog(shader));
+return shader;
+};
+this.handleLoadedTexture = function(texture, textureCanvas) {
+var gl = this.gl || this.initGL();
+gl.pixelStorei(gl.UNPACK_FLIP_Y_WEBGL, true);
+gl.bindTexture(gl.TEXTURE_2D, texture);
+gl.texImage2D(gl.TEXTURE_2D, 0, gl.RGBA, gl.RGBA, gl.UNSIGNED_BYTE, textureCanvas);
+gl.texParameteri(gl.TEXTURE_2D, gl.TEXTURE_MAG_FILTER, gl.LINEAR);
+gl.texParameteri(gl.TEXTURE_2D, gl.TEXTURE_MIN_FILTER, gl.LINEAR_MIPMAP_NEAREST);
+gl.generateMipmap(gl.TEXTURE_2D);
+gl.bindTexture(gl.TEXTURE_2D, null);
+};
+this.loadImageToTexture = function(uri, texture) {
+var canvas = this.textureCanvas,
+ctx = canvas.getContext("2d"),
+image = new Image(),
+self = this;
+image.onload = function() {
+var w = image.width,
+h = image.height,
+canvasX = self.getPowerOfTwo(w),
+canvasY = self.getPowerOfTwo(h),
+gl = self.gl || self.initGL(),
+maxTexSize = gl.getParameter(gl.MAX_TEXTURE_SIZE);
+if (maxTexSize > 4096) maxTexSize = 4096;
+while (canvasX > 1 && canvasY > 1 && (canvasX > maxTexSize || canvasY > maxTexSize)) {
+canvasX /= 2;
+canvasY /= 2;
+}
+canvas.width = canvasX;
+canvas.height = canvasY;
+ctx.imageSmoothingEnabled = true;
+ctx.drawImage(image, 0, 0, canvasX, canvasY);
+self.handleLoadedTexture(texture, canvas);
+self.drawScene();
+};
+image.src = uri;
+};
+this.drawTextToCanvas = function(text, cex, family, font) {
+var canvasX, canvasY,
+textY,
+scaling = 20,
+textColour = "white",
+backgroundColour = "rgba(0,0,0,0)",
+canvas = this.textureCanvas,
+ctx = canvas.getContext("2d"),
+i, textHeights = [], widths = [], offset = 0, offsets = [],
+fontStrings = [],
+getFontString = function(i) {
+textHeights[i] = scaling*cex[i];
+var fontString = textHeights[i] + "px",
+family0 = family[i],
+font0 = font[i];
+if (family0 === "sans")
+family0 = "sans-serif";
+else if (family0 === "mono")
+family0 = "monospace";
+fontString = fontString + " " + family0;
+if (font0 === 2 || font0 === 4)
+fontString = "bold " + fontString;
+if (font0 === 3 || font0 === 4)
+fontString = "italic " + fontString;
+return fontString;
+};
+cex = this.repeatToLen(cex, text.length);
+family = this.repeatToLen(family, text.length);
+font = this.repeatToLen(font, text.length);
+canvasX = 1;
+for (i = 0; i < text.length; i++) {
+ctx.font = fontStrings[i] = getFontString(i);
+widths[i] = ctx.measureText(text[i]).width;
+offset = offsets[i] = offset + 2*textHeights[i];
+canvasX = (widths[i] > canvasX) ? widths[i] : canvasX;
+}
+canvasX = this.getPowerOfTwo(canvasX);
+canvasY = this.getPowerOfTwo(offset);
+canvas.width = canvasX;
+canvas.height = canvasY;
+ctx.fillStyle = backgroundColour;
+ctx.fillRect(0, 0, ctx.canvas.width, ctx.canvas.height);
+ctx.textBaseline = "alphabetic";
+for(i = 0; i < text.length; i++) {
+textY = offsets[i];
+ctx.font = fontStrings[i];
+ctx.fillStyle = textColour;
+ctx.textAlign = "left";
+ctx.fillText(text[i], 0, textY);
+}
+return {canvasX:canvasX, canvasY:canvasY,
+widths:widths, textHeights:textHeights,
+offsets:offsets};
+};
+this.setViewport = function(id) {
+var gl = this.gl || this.initGL(),
+vp = this.getObj(id).par3d.viewport,
+x = vp.x*this.canvas.width,
+y = vp.y*this.canvas.height,
+width = vp.width*this.canvas.width,
+height = vp.height*this.canvas.height;
+this.vp = {x:x, y:y, width:width, height:height};
+gl.viewport(x, y, width, height);
+gl.scissor(x, y, width, height);
+gl.enable(gl.SCISSOR_TEST);
+};
+this.setprMatrix = function(id) {
+var subscene = this.getObj(id),
+embedding = subscene.embeddings.projection;
+if (embedding === "replace")
+this.prMatrix.makeIdentity();
+else
+this.setprMatrix(subscene.parent);
+if (embedding === "inherit")
+return;
+// This is based on the Frustum::enclose code from geom.cpp
+var bbox = subscene.par3d.bbox,
+scale = subscene.par3d.scale,
+ranges = [(bbox[1]-bbox[0])*scale[0]/2,
+(bbox[3]-bbox[2])*scale[1]/2,
+(bbox[5]-bbox[4])*scale[2]/2],
+radius = Math.sqrt(this.sumsq(ranges))*1.1; // A bit bigger to handle labels
+if (radius <= 0) radius = 1;
+var observer = subscene.par3d.observer,
+distance = observer[2],
+FOV = subscene.par3d.FOV, ortho = FOV === 0,
+t = ortho ? 1 : Math.tan(FOV*Math.PI/360),
+near = distance - radius,
+far = distance + radius,
+hlen,
+aspect = this.vp.width/this.vp.height,
+z = subscene.par3d.zoom;
+if (far < 0.)
+far = 1.;
+if (near < far/100.)
+near = far/100.;
+hlen = t*near;
+if (ortho) {
+if (aspect > 1)
+this.prMatrix.ortho(-hlen*aspect*z, hlen*aspect*z,
+-hlen*z, hlen*z, near, far);
+else
+this.prMatrix.ortho(-hlen*z, hlen*z,
+-hlen*z/aspect, hlen*z/aspect,
+near, far);
+} else {
+if (aspect > 1)
+this.prMatrix.frustum(-hlen*aspect*z, hlen*aspect*z,
+-hlen*z, hlen*z, near, far);
+else
+this.prMatrix.frustum(-hlen*z, hlen*z,
+-hlen*z/aspect, hlen*z/aspect,
+near, far);
+}
+};
+this.setmvMatrix = function(id) {
+var observer = this.getObj(id).par3d.observer;
+this.mvMatrix.makeIdentity();
+this.setmodelMatrix(id);
+this.mvMatrix.translate(-observer[0], -observer[1], -observer[2]);
+};
+this.setmodelMatrix = function(id) {
+var subscene = this.getObj(id),
+embedding = subscene.embeddings.model;
+if (embedding !== "inherit") {
+var scale = subscene.par3d.scale,
+bbox = subscene.par3d.bbox,
+center = [(bbox[0]+bbox[1])/2,
+(bbox[2]+bbox[3])/2,
+(bbox[4]+bbox[5])/2];
+this.mvMatrix.translate(-center[0], -center[1], -center[2]);
+this.mvMatrix.scale(scale[0], scale[1], scale[2]);
+this.mvMatrix.multRight( subscene.par3d.userMatrix );
+}
+if (embedding !== "replace")
+this.setmodelMatrix(subscene.parent);
+};
+this.setnormMatrix = function(subsceneid) {
+var self = this,
+recurse = function(id) {
+var sub = self.getObj(id),
+embedding = sub.embeddings.model;
+if (embedding !== "inherit") {
+var scale = sub.par3d.scale;
+self.normMatrix.scale(1/scale[0], 1/scale[1], 1/scale[2]);
+self.normMatrix.multRight(sub.par3d.userMatrix);
+}
+if (embedding !== "replace")
+recurse(sub.parent);
+};
+self.normMatrix.makeIdentity();
+recurse(subsceneid);
+};
+this.setprmvMatrix = function() {
+this.prmvMatrix = new CanvasMatrix4( this.mvMatrix );
+this.prmvMatrix.multRight( this.prMatrix );
+};
+this.countClipplanes = function() {
+return this.countObjs("clipplanes");
+};
+this.countLights = function() {
+return this.countObjs("light");
+};
+this.countObjs = function(type) {
+var self = this,
+bound = 0;
+Object.keys(this.scene.objects).forEach(
+function(key) {
+if (self.getObj(parseInt(key, 10)).type === type)
+bound = bound + 1;
+});
+return bound;
+};
+this.initSubscene = function(id) {
+var sub = this.getObj(id),
+i, obj;
+if (sub.type !== "subscene")
+return;
+sub.par3d.userMatrix = this.toCanvasMatrix4(sub.par3d.userMatrix);
+sub.par3d.listeners = [].concat(sub.par3d.listeners);
+sub.backgroundId = undefined;
+sub.subscenes = [];
+sub.clipplanes = [];
+sub.transparent = [];
+sub.opaque = [];
+sub.lights = [];
+for (i=0; i < sub.objects.length; i++) {
+obj = this.getObj(sub.objects[i]);
+if (typeof obj === "undefined") {
+sub.objects.splice(i, 1);
+i--;
+} else if (obj.type === "background")
+sub.backgroundId = obj.id;
+else
+sub[this.whichList(obj.id)].push(obj.id);
+}
+};
+this.copyObj = function(id, reuse) {
+var obj = this.getObj(id),
+prev = document.getElementById(reuse);
+if (prev !== null) {
+prev = prev.rglinstance;
+var
+prevobj = prev.getObj(id),
+fields = ["flags", "type",
+"colors", "vertices", "centers",
+"normals", "offsets",
+"texts", "cex", "family", "font", "adj",
+"material",
+"radii",
+"texcoords",
+"userMatrix", "ids",
+"dim",
+"par3d", "userMatrix",
+"viewpoint", "finite"],
+i;
+for (i = 0; i < fields.length; i++) {
+if (typeof prevobj[fields[i]] !== "undefined")
+obj[fields[i]] = prevobj[fields[i]];
+}
+} else
+console.warn("copyObj failed");
+};
+this.planeUpdateTriangles = function(id, bbox) {
+var perms = [[0,0,1], [1,2,2], [2,1,0]],
+x, xrow, elem, A, d, nhits, i, j, k, u, v, w, intersect, which, v0, v2, vx, reverse,
+face1 = [], face2 = [], normals = [],
+obj = this.getObj(id),
+nPlanes = obj.normals.length;
+obj.bbox = bbox;
+obj.vertices = [];
+obj.initialized = false;
+for (elem = 0; elem < nPlanes; elem++) {
+// Vertex Av = normal.getRecycled(elem);
+x = [];
+A = obj.normals[elem];
+d = obj.offsets[elem][0];
+nhits = 0;
+for (i=0; i<3; i++)
+for (j=0; j<2; j++)
+for (k=0; k<2; k++) {
+u = perms[0][i];
+v = perms[1][i];
+w = perms[2][i];
+if (A[w] !== 0.0) {
+intersect = -(d + A[u]*bbox[j+2*u] + A[v]*bbox[k+2*v])/A[w];
+if (bbox[2*w] < intersect && intersect < bbox[1+2*w]) {
+xrow = [];
+xrow[u] = bbox[j+2*u];
+xrow[v] = bbox[k+2*v];
+xrow[w] = intersect;
+x.push(xrow);
+face1[nhits] = j + 2*u;
+face2[nhits] = k + 2*v;
+nhits++;
+}
+}
+}
+if (nhits > 3) {
+/* Re-order the intersections so the triangles work */
+for (i=0; i<nhits-2; i++) {
+which = 0; /* initialize to suppress warning */
+for (j=i+1; j<nhits; j++) {
+if (face1[i] == face1[j] || face1[i] == face2[j] ||
+face2[i] == face1[j] || face2[i] == face2[j] ) {
+which = j;
+break;
+}
+}
+if (which > i+1) {
+this.swap(x, i+1, which);
+this.swap(face1, i+1, which);
+this.swap(face2, i+1, which);
+}
+}
+}
+if (nhits >= 3) {
+/* Put in order so that the normal points out the FRONT of the faces */
+v0 = [x[0][0] - x[1][0] , x[0][1] - x[1][1], x[0][2] - x[1][2]];
+v2 = [x[2][0] - x[1][0] , x[2][1] - x[1][1], x[2][2] - x[1][2]];
+/* cross-product */
+vx = this.xprod(v0, v2);
+reverse = this.dotprod(vx, A) > 0;
+for (i=0; i<nhits-2; i++) {
+obj.vertices.push(x[0]);
+normals.push(A);
+for (j=1; j<3; j++) {
+obj.vertices.push(x[i + (reverse ? 3-j : j)]);
+normals.push(A);
+}
+}
+}
+}
+obj.pnormals = normals;
+};
+this.initObj = function(id) {
+var obj = this.getObj(id),
+flags = obj.flags,
+type = obj.type,
+is_indexed = flags & this.f_is_indexed,
+is_lit = flags & this.f_is_lit,
+has_texture = flags & this.f_has_texture,
+fixed_quads = flags & this.f_fixed_quads,
+depth_sort = flags & this.f_depth_sort,
+sprites_3d = flags & this.f_sprites_3d,
+sprite_3d = flags & this.f_sprite_3d,
+fixed_size = flags & this.f_fixed_size,
+is_twosided = (flags & this.f_is_twosided) > 0,
+gl = this.gl || this.initGL(),
+texinfo, drawtype, nclipplanes, f, nrows,
+i,j,v,v1,v2, mat, uri, matobj, pass, pmode,
+dim, nx, nz, attr;
+if (typeof id !== "number") {
+this.alertOnce("initObj id is "+typeof id);
+}
+obj.initialized = true;
+if (type === "bboxdeco" || type === "subscene")
+return;
+if (type === "light") {
+obj.ambient = new Float32Array(obj.colors[0].slice(0,3));
+obj.diffuse = new Float32Array(obj.colors[1].slice(0,3));
+obj.specular = new Float32Array(obj.colors[2].slice(0,3));
+obj.lightDir = new Float32Array(obj.vertices[0]);
+return;
+}
+if (type === "clipplanes") {
+obj.vClipplane = this.flatten(this.cbind(obj.normals, obj.offsets));
+return;
+}
+if (type == "background" && typeof obj.ids !== "undefined") {
+obj.quad = this.flatten([].concat(obj.ids));
+return;
+}
+if (typeof obj.vertices === "undefined")
+obj.vertices = [];
+v = obj.vertices;
+obj.vertexCount = v.length;
+if (!obj.vertexCount) return;
+if (is_twosided) {
+if (typeof obj.userAttributes === "undefined")
+obj.userAttributes = {};
+v1 = Array(v.length);
+v2 = Array(v.length);
+if (obj.type == "triangles" || obj.type == "quads") {
+if (obj.type == "triangles")
+nrow = 3;
+else
+nrow = 4;
+for (i=0; i<Math.floor(v.length/nrow); i++)
+for (j=0; j<nrow; j++) {
+v1[nrow*i + j] = v[nrow*i + ((j+1) % nrow)];
+v2[nrow*i + j] = v[nrow*i + ((j+2) % nrow)];
+}
+} else if (obj.type == "surface") {
+dim = obj.dim[0];
+nx = dim[0];
+nz = dim[1];
+for (j=0; j<nx; j++) {
+for (i=0; i<nz; i++) {
+if (i+1 < nz && j+1 < nx) {
+v2[j + nx*i] = v[j + nx*(i+1)];
+v1[j + nx*i] = v[j+1 + nx*(i+1)];
+} else if (i+1 < nz) {
+v2[j + nx*i] = v[j-1 + nx*i];
+v1[j + nx*i] = v[j + nx*(i+1)];
+} else {
+v2[j + nx*i] = v[j + nx*(i-1)];
+v1[j + nx*i] = v[j-1 + nx*(i-1)];
+}
+}
+}
+}
+obj.userAttributes.aPos1 = v1;
+obj.userAttributes.aPos2 = v2;
+}
+if (!sprites_3d) {
+if (gl.isContextLost()) return;
+obj.prog = gl.createProgram();
+gl.attachShader(obj.prog, this.getShader( gl.VERTEX_SHADER,
+this.getVertexShader(id) ));
+gl.attachShader(obj.prog, this.getShader( gl.FRAGMENT_SHADER,
+this.getFragmentShader(id) ));
+// Force aPos to location 0, aCol to location 1
+gl.bindAttribLocation(obj.prog, 0, "aPos");
+gl.bindAttribLocation(obj.prog, 1, "aCol");
+gl.linkProgram(obj.prog);
+var linked = gl.getProgramParameter(obj.prog, gl.LINK_STATUS);
+if (!linked) {
+// An error occurred while linking
+var lastError = gl.getProgramInfoLog(obj.prog);
+console.warn("Error in program linking:" + lastError);
+gl.deleteProgram(obj.prog);
+return;
+}
+}
+if (type === "text") {
+texinfo = this.drawTextToCanvas(obj.texts,
+this.flatten(obj.cex),
+this.flatten(obj.family),
+this.flatten(obj.family));
+}
+if (fixed_quads && !sprites_3d) {
+obj.ofsLoc = gl.getAttribLocation(obj.prog, "aOfs");
+}
+if (sprite_3d) {
+obj.origLoc = gl.getUniformLocation(obj.prog, "uOrig");
+obj.sizeLoc = gl.getUniformLocation(obj.prog, "uSize");
+obj.usermatLoc = gl.getUniformLocation(obj.prog, "usermat");
+}
+if (has_texture || type == "text") {
+obj.texture = gl.createTexture();
+obj.texLoc = gl.getAttribLocation(obj.prog, "aTexcoord");
+obj.sampler = gl.getUniformLocation(obj.prog, "uSampler");
+}
+if (has_texture) {
+mat = obj.material;
+if (typeof mat.uri !== "undefined")
+uri = mat.uri;
+else if (typeof mat.uriElementId === "undefined") {
+matobj = this.getObj(mat.uriId);
+if (typeof matobj !== "undefined") {
+uri = matobj.material.uri;
+} else {
+uri = "";
+}
+} else
+uri = document.getElementById(mat.uriElementId).rglinstance.getObj(mat.uriId).material.uri;
+this.loadImageToTexture(uri, obj.texture);
+}
+if (type === "text") {
+this.handleLoadedTexture(obj.texture, this.textureCanvas);
+}
+var stride = 3, nc, cofs, nofs, radofs, oofs, tofs, vnew;
+nc = obj.colorCount = obj.colors.length;
+if (nc > 1) {
+cofs = stride;
+stride = stride + 4;
+v = this.cbind(v, obj.colors);
+} else {
+cofs = -1;
+obj.onecolor = this.flatten(obj.colors);
+}
+if (typeof obj.normals !== "undefined") {
+nofs = stride;
+stride = stride + 3;
+v = this.cbind(v, typeof obj.pnormals !== "undefined" ? obj.pnormals : obj.normals);
+} else
+nofs = -1;
+if (typeof obj.radii !== "undefined") {
+radofs = stride;
+stride = stride + 1;
+// FIXME: always concat the radii?
+if (obj.radii.length === v.length) {
+v = this.cbind(v, obj.radii);
+} else if (obj.radii.length === 1) {
+v = v.map(function(row, i, arr) { return row.concat(obj.radii[0]);});
+}
+} else
+radofs = -1;
+if (type == "sprites" && !sprites_3d) {
+tofs = stride;
+stride += 2;
+oofs = stride;
+stride += 2;
+vnew = new Array(4*v.length);
+var rescale = fixed_size ? 72 : 1,
+size = obj.radii, s = rescale*size[0]/2;
+for (i=0; i < v.length; i++) {
+if (size.length > 1)
+s = rescale*size[i]/2;
+vnew[4*i] = v[i].concat([0,0,-s,-s]);
+vnew[4*i+1]= v[i].concat([1,0, s,-s]);
+vnew[4*i+2]= v[i].concat([1,1, s, s]);
+vnew[4*i+3]= v[i].concat([0,1,-s, s]);
+}
+v = vnew;
+obj.vertexCount = v.length;
+} else if (type === "text") {
+tofs = stride;
+stride += 2;
+oofs = stride;
+stride += 2;
+vnew = new Array(4*v.length);
+for (i=0; i < v.length; i++) {
+vnew[4*i] = v[i].concat([0,-0.5]).concat(obj.adj[0]);
+vnew[4*i+1]= v[i].concat([1,-0.5]).concat(obj.adj[0]);
+vnew[4*i+2]= v[i].concat([1, 1.5]).concat(obj.adj[0]);
+vnew[4*i+3]= v[i].concat([0, 1.5]).concat(obj.adj[0]);
+for (j=0; j < 4; j++) {
+v1 = vnew[4*i+j];
+v1[tofs+2] = 2*(v1[tofs]-v1[tofs+2])*texinfo.widths[i];
+v1[tofs+3] = 2*(v1[tofs+1]-v1[tofs+3])*texinfo.textHeights[i];
+v1[tofs] *= texinfo.widths[i]/texinfo.canvasX;
+v1[tofs+1] = 1.0-(texinfo.offsets[i] -
+v1[tofs+1]*texinfo.textHeights[i])/texinfo.canvasY;
+vnew[4*i+j] = v1;
+}
+}
+v = vnew;
+obj.vertexCount = v.length;
+} else if (typeof obj.texcoords !== "undefined") {
+tofs = stride;
+stride += 2;
+oofs = -1;
+v = this.cbind(v, obj.texcoords);
+} else {
+tofs = -1;
+oofs = -1;
+}
+if (typeof obj.userAttributes !== "undefined") {
+obj.userAttribOffsets = {};
+obj.userAttribLocations = {};
+obj.userAttribSizes = {};
+for (attr in obj.userAttributes) {
+obj.userAttribLocations[attr] = gl.getAttribLocation(obj.prog, attr);
+if (obj.userAttribLocations[attr] >= 0) { // Attribute may not have been used
+obj.userAttribOffsets[attr] = stride;
+v = this.cbind(v, obj.userAttributes[attr]);
+stride = v[0].length;
+obj.userAttribSizes[attr] = stride - obj.userAttribOffsets[attr];
+}
+}
+}
+if (typeof obj.userUniforms !== "undefined") {
+obj.userUniformLocations = {};
+for (attr in obj.userUniforms)
+obj.userUniformLocations[attr] = gl.getUniformLocation(obj.prog, attr);
+}
+if (stride !== v[0].length) {
+this.alertOnce("problem in stride calculation");
+}
+obj.vOffsets = {vofs:0, cofs:cofs, nofs:nofs, radofs:radofs, oofs:oofs, tofs:tofs, stride:stride};
+obj.values = new Float32Array(this.flatten(v));
+if (sprites_3d) {
+obj.userMatrix = new CanvasMatrix4(obj.userMatrix);
+obj.objects = this.flatten([].concat(obj.ids));
+is_lit = false;
+}
+if (is_lit && !fixed_quads) {
+obj.normLoc = gl.getAttribLocation(obj.prog, "aNorm");
+}
+nclipplanes = this.countClipplanes();
+if (nclipplanes && !sprites_3d) {
+obj.clipLoc = [];
+for (i=0; i < nclipplanes; i++)
+obj.clipLoc[i] = gl.getUniformLocation(obj.prog,"vClipplane" + i);
+}
+if (is_lit) {
+obj.emissionLoc = gl.getUniformLocation(obj.prog, "emission");
+obj.emission = new Float32Array(this.stringToRgb(this.getMaterial(id, "emission")));
+obj.shininessLoc = gl.getUniformLocation(obj.prog, "shininess");
+obj.shininess = this.getMaterial(id, "shininess");
+obj.nlights = this.countLights();
+obj.ambientLoc = [];
+obj.ambient = new Float32Array(this.stringToRgb(this.getMaterial(id, "ambient")));
+obj.specularLoc = [];
+obj.specular = new Float32Array(this.stringToRgb(this.getMaterial(id, "specular")));
+obj.diffuseLoc = [];
+obj.lightDirLoc = [];
+obj.viewpointLoc = [];
+obj.finiteLoc = [];
+for (i=0; i < obj.nlights; i++) {
+obj.ambientLoc[i] = gl.getUniformLocation(obj.prog, "ambient" + i);
+obj.specularLoc[i] = gl.getUniformLocation(obj.prog, "specular" + i);
+obj.diffuseLoc[i] = gl.getUniformLocation(obj.prog, "diffuse" + i);
+obj.lightDirLoc[i] = gl.getUniformLocation(obj.prog, "lightDir" + i);
+obj.viewpointLoc[i] = gl.getUniformLocation(obj.prog, "viewpoint" + i);
+obj.finiteLoc[i] = gl.getUniformLocation(obj.prog, "finite" + i);
+}
+}
+if (is_indexed) {
+obj.f = Array(2);
+for (pass = 0; pass < is_twosided + 1; pass++) {
+if (type === "triangles" || type === "quads" || type === "surface")
+pmode = this.getMaterial(id, (pass === 0) ? "front" : "back");
+else pmode = "filled";
+if (pmode === "culled")
+continue;
+if (pmode === "points") {
+nrows = obj.vertexCount;
+f = Array(nrows);
+for (i=0; i < nrows; i++)
+f[i] = i;
+} else if ((type === "quads" || type === "text" ||
+type === "sprites") && !sprites_3d) {
+nrows = Math.floor(obj.vertexCount/4);
+if (pmode === "filled") {
+f = Array(6*nrows);
+for (i=0; i < nrows; i++) {
+f[6*i] = 4*i;
+f[6*i+1] = 4*i + 1;
+f[6*i+2] = 4*i + 2;
+f[6*i+3] = 4*i;
+f[6*i+4] = 4*i + 2;
+f[6*i+5] = 4*i + 3;
+}
+} else {
+f = Array(8*nrows);
+for (i=0; i < nrows; i++) {
+f[8*i] = 4*i;
+f[8*i+1] = 4*i + 1;
+f[8*i+2] = 4*i + 1;
+f[8*i+3] = 4*i + 2;
+f[8*i+4] = 4*i + 2;
+f[8*i+5] = 4*i + 3;
+f[8*i+6] = 4*i + 3;
+f[8*i+7] = 4*i;
+}
+}
+} else if (type === "triangles") {
+nrows = Math.floor(obj.vertexCount/3);
+if (pmode === "filled") {
+f = Array(3*nrows);
+for (i=0; i < f.length; i++) {
+f[i] = i;
+}
+} else if (pmode === "lines") {
+f = Array(6*nrows);
+for (i=0; i < nrows; i++) {
+f[6*i] = 3*i;
+f[6*i + 1] = 3*i + 1;
+f[6*i + 2] = 3*i + 1;
+f[6*i + 3] = 3*i + 2;
+f[6*i + 4] = 3*i + 2;
+f[6*i + 5] = 3*i;
+}
+}
+} else if (type === "spheres") {
+nrows = obj.vertexCount;
+f = Array(nrows);
+for (i=0; i < f.length; i++) {
+f[i] = i;
+}
+} else if (type === "surface") {
+dim = obj.dim[0];
+nx = dim[0];
+nz = dim[1];
+if (pmode === "filled") {
+f = [];
+for (j=0; j<nx-1; j++) {
+for (i=0; i<nz-1; i++) {
+f.push(j + nx*i,
+j + nx*(i+1),
+j + 1 + nx*(i+1),
+j + nx*i,
+j + 1 + nx*(i+1),
+j + 1 + nx*i);
+}
+}
+} else if (pmode === "lines") {
+f = [];
+for (j=0; j<nx; j++) {
+for (i=0; i<nz; i++) {
+if (i+1 < nz)
+f.push(j + nx*i,
+j + nx*(i+1));
+if (j+1 < nx)
+f.push(j + nx*i,
+j+1 + nx*i);
+}
+}
+}
+}
+obj.f[pass] = new Uint16Array(f);
+if (depth_sort) {
+drawtype = "DYNAMIC_DRAW";
+} else {
+drawtype = "STATIC_DRAW";
+}
+}
+}
+if (type !== "spheres" && !sprites_3d) {
+obj.buf = gl.createBuffer();
+gl.bindBuffer(gl.ARRAY_BUFFER, obj.buf);
+gl.bufferData(gl.ARRAY_BUFFER, obj.values, gl.STATIC_DRAW); //
+}
+if (is_indexed && type !== "spheres" && !sprites_3d) {
+obj.ibuf = Array(is_twosided + 1);
+obj.ibuf[0] = gl.createBuffer();
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, obj.ibuf[0]);
+gl.bufferData(gl.ELEMENT_ARRAY_BUFFER, obj.f[0], gl[drawtype]);
+if (is_twosided) {
+obj.ibuf[1] = gl.createBuffer();
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, obj.ibuf[1]);
+gl.bufferData(gl.ELEMENT_ARRAY_BUFFER, obj.f[1], gl[drawtype]);
+}
+}
+if (!sprites_3d) {
+obj.mvMatLoc = gl.getUniformLocation(obj.prog, "mvMatrix");
+obj.prMatLoc = gl.getUniformLocation(obj.prog, "prMatrix");
+}
+if (fixed_size) {
+obj.textScaleLoc = gl.getUniformLocation(obj.prog, "textScale");
+}
+if (is_lit && !sprites_3d) {
+obj.normMatLoc = gl.getUniformLocation(obj.prog, "normMatrix");
+}
+if (is_twosided) {
+obj.frontLoc = gl.getUniformLocation(obj.prog, "front");
+}
+};
+this.setDepthTest = function(id) {
+var gl = this.gl || this.initGL(),
+tests = {never: gl.NEVER,
+less: gl.LESS,
+equal: gl.EQUAL,
+lequal:gl.LEQUAL,
+greater: gl.GREATER,
+notequal: gl.NOTEQUAL,
+gequal: gl.GEQUAL,
+always: gl.ALWAYS},
+test = tests[this.getMaterial(id, "depth_test")];
+gl.depthFunc(test);
+};
+this.mode4type = {points : "POINTS",
+linestrip : "LINE_STRIP",
+abclines : "LINES",
+lines : "LINES",
+sprites : "TRIANGLES",
+planes : "TRIANGLES",
+text : "TRIANGLES",
+quads : "TRIANGLES",
+surface : "TRIANGLES",
+triangles : "TRIANGLES"};
+this.drawObj = function(id, subsceneid) {
+var obj = this.getObj(id),
+subscene = this.getObj(subsceneid),
+flags = obj.flags,
+type = obj.type,
+is_indexed = flags & this.f_is_indexed,
+is_lit = flags & this.f_is_lit,
+has_texture = flags & this.f_has_texture,
+fixed_quads = flags & this.f_fixed_quads,
+depth_sort = flags & this.f_depth_sort,
+sprites_3d = flags & this.f_sprites_3d,
+sprite_3d = flags & this.f_sprite_3d,
+is_lines = flags & this.f_is_lines,
+is_points = flags & this.f_is_points,
+fixed_size = flags & this.f_fixed_size,
+is_twosided = (flags & this.f_is_twosided) > 0,
+gl = this.gl || this.initGL(),
+mat,
+sphereMV, baseofs, ofs, sscale, i, count, light,
+faces, pass, mode, pmode, attr,
+depthsort = function(i,j) { return depths[j] - depths[i]; };
+if (typeof id !== "number") {
+this.alertOnce("drawObj id is "+typeof id);
+}
+if (type === "planes") {
+if (obj.bbox !== subscene.par3d.bbox || !obj.initialized) {
+this.planeUpdateTriangles(id, subscene.par3d.bbox);
+}
+}
+if (!obj.initialized)
+this.initObj(id);
+if (type === "clipplanes") {
+count = obj.offsets.length;
+var IMVClip = [];
+for (i=0; i < count; i++) {
+IMVClip[i] = this.multMV(this.invMatrix, obj.vClipplane.slice(4*i, 4*(i+1)));
+}
+obj.IMVClip = IMVClip;
+return;
+}
+if (type === "light" || type === "bboxdeco" || !obj.vertexCount)
+return;
+this.setDepthTest(id);
+if (sprites_3d) {
+var norigs = obj.vertices.length,
+savenorm = new CanvasMatrix4(this.normMatrix);
+this.origs = obj.vertices;
+this.usermat = new Float32Array(obj.userMatrix.getAsArray());
+this.radii = obj.radii;
+this.normMatrix = subscene.spriteNormmat;
+for (this.iOrig=0; this.iOrig < norigs; this.iOrig++) {
+for (i=0; i < obj.objects.length; i++) {
+this.drawObj(obj.objects[i], subsceneid);
+}
+}
+this.normMatrix = savenorm;
+return;
+} else {
+gl.useProgram(obj.prog);
+}
+if (sprite_3d) {
+gl.uniform3fv(obj.origLoc, new Float32Array(this.origs[this.iOrig]));
+if (this.radii.length > 1) {
+gl.uniform1f(obj.sizeLoc, this.radii[this.iOrig][0]);
+} else {
+gl.uniform1f(obj.sizeLoc, this.radii[0][0]);
+}
+gl.uniformMatrix4fv(obj.usermatLoc, false, this.usermat);
+}
+if (type === "spheres") {
+gl.bindBuffer(gl.ARRAY_BUFFER, this.sphere.buf);
+} else {
+gl.bindBuffer(gl.ARRAY_BUFFER, obj.buf);
+}
+gl.uniformMatrix4fv( obj.prMatLoc, false, new Float32Array(this.prMatrix.getAsArray()) );
+gl.uniformMatrix4fv( obj.mvMatLoc, false, new Float32Array(this.mvMatrix.getAsArray()) );
+var clipcheck = 0,
+clipplaneids = subscene.clipplanes,
+clip, j;
+for (i=0; i < clipplaneids.length; i++) {
+clip = this.getObj(clipplaneids[i]);
+for (j=0; j < clip.offsets.length; j++) {
+gl.uniform4fv(obj.clipLoc[clipcheck + j], clip.IMVClip[j]);
+}
+clipcheck += clip.offsets.length;
+}
+if (typeof obj.clipLoc !== "undefined")
+for (i=clipcheck; i < obj.clipLoc.length; i++)
+gl.uniform4f(obj.clipLoc[i], 0,0,0,0);
+if (is_lit) {
+gl.uniformMatrix4fv( obj.normMatLoc, false, new Float32Array(this.normMatrix.getAsArray()) );
+gl.uniform3fv( obj.emissionLoc, obj.emission);
+gl.uniform1f( obj.shininessLoc, obj.shininess);
+for (i=0; i < subscene.lights.length; i++) {
+light = this.getObj(subscene.lights[i]);
+gl.uniform3fv( obj.ambientLoc[i], this.componentProduct(light.ambient, obj.ambient));
+gl.uniform3fv( obj.specularLoc[i], this.componentProduct(light.specular, obj.specular));
+gl.uniform3fv( obj.diffuseLoc[i], light.diffuse);
+gl.uniform3fv( obj.lightDirLoc[i], light.lightDir);
+gl.uniform1i( obj.viewpointLoc[i], light.viewpoint);
+gl.uniform1i( obj.finiteLoc[i], light.finite);
+}
+for (i=subscene.lights.length; i < obj.nlights; i++) {
+gl.uniform3f( obj.ambientLoc[i], 0,0,0);
+gl.uniform3f( obj.specularLoc[i], 0,0,0);
+gl.uniform3f( obj.diffuseLoc[i], 0,0,0);
+}
+}
+if (fixed_size) {
+gl.uniform2f( obj.textScaleLoc, 0.75/this.vp.width, 0.75/this.vp.height);
+}
+gl.enableVertexAttribArray( this.posLoc );
+var nc = obj.colorCount;
+count = obj.vertexCount;
+if (type === "spheres") {
+subscene = this.getObj(subsceneid);
+var scale = subscene.par3d.scale,
+scount = count;
+gl.vertexAttribPointer(this.posLoc, 3, gl.FLOAT, false, 4*this.sphere.vOffsets.stride, 0);
+gl.enableVertexAttribArray(obj.normLoc );
+gl.vertexAttribPointer(obj.normLoc, 3, gl.FLOAT, false, 4*this.sphere.vOffsets.stride, 0);
+gl.disableVertexAttribArray( this.colLoc );
+var sphereNorm = new CanvasMatrix4();
+sphereNorm.scale(scale[0], scale[1], scale[2]);
+sphereNorm.multRight(this.normMatrix);
+gl.uniformMatrix4fv( obj.normMatLoc, false, new Float32Array(sphereNorm.getAsArray()) );
+if (nc == 1) {
+gl.vertexAttrib4fv( this.colLoc, new Float32Array(obj.onecolor));
+}
+if (has_texture) {
+gl.enableVertexAttribArray( obj.texLoc );
+gl.vertexAttribPointer(obj.texLoc, 2, gl.FLOAT, false, 4*this.sphere.vOffsets.stride,
+4*this.sphere.vOffsets.tofs);
+gl.activeTexture(gl.TEXTURE0);
+gl.bindTexture(gl.TEXTURE_2D, obj.texture);
+gl.uniform1i( obj.sampler, 0);
+}
+for (i = 0; i < scount; i++) {
+sphereMV = new CanvasMatrix4();
+if (depth_sort) {
+baseofs = faces[i]*obj.vOffsets.stride;
+} else {
+baseofs = i*obj.vOffsets.stride;
+}
+ofs = baseofs + obj.vOffsets.radofs;
+sscale = obj.values[ofs];
+sphereMV.scale(sscale/scale[0], sscale/scale[1], sscale/scale[2]);
+sphereMV.translate(obj.values[baseofs],
+obj.values[baseofs+1],
+obj.values[baseofs+2]);
+sphereMV.multRight(this.mvMatrix);
+gl.uniformMatrix4fv( obj.mvMatLoc, false, new Float32Array(sphereMV.getAsArray()) );
+if (nc > 1) {
+ofs = baseofs + obj.vOffsets.cofs;
+gl.vertexAttrib4f( this.colLoc, obj.values[ofs],
+obj.values[ofs+1],
+obj.values[ofs+2],
+obj.values[ofs+3] );
+}
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, this.sphere.ibuf);
+gl.drawElements(gl.TRIANGLES, this.sphere.sphereCount, gl.UNSIGNED_SHORT, 0);
+}
+return;
+} else {
+if (obj.colorCount === 1) {
+gl.disableVertexAttribArray( this.colLoc );
+gl.vertexAttrib4fv( this.colLoc, new Float32Array(obj.onecolor));
+} else {
+gl.enableVertexAttribArray( this.colLoc );
+gl.vertexAttribPointer(this.colLoc, 4, gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.vOffsets.cofs);
+}
+}
+if (is_lit && obj.vOffsets.nofs > 0) {
+gl.enableVertexAttribArray( obj.normLoc );
+gl.vertexAttribPointer(obj.normLoc, 3, gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.vOffsets.nofs);
+}
+if (has_texture || type === "text") {
+gl.enableVertexAttribArray( obj.texLoc );
+gl.vertexAttribPointer(obj.texLoc, 2, gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.vOffsets.tofs);
+gl.activeTexture(gl.TEXTURE0);
+gl.bindTexture(gl.TEXTURE_2D, obj.texture);
+gl.uniform1i( obj.sampler, 0);
+}
+if (fixed_quads) {
+gl.enableVertexAttribArray( obj.ofsLoc );
+gl.vertexAttribPointer(obj.ofsLoc, 2, gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.vOffsets.oofs);
+}
+if (typeof obj.userAttributes !== "undefined") {
+for (attr in obj.userAttribSizes) { // Not all attributes may have been used
+gl.enableVertexAttribArray( obj.userAttribLocations[attr] );
+gl.vertexAttribPointer( obj.userAttribLocations[attr], obj.userAttribSizes[attr],
+gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.userAttribOffsets[attr]);
+}
+}
+if (typeof obj.userUniforms !== "undefined") {
+for (attr in obj.userUniformLocations) {
+var loc = obj.userUniformLocations[attr];
+if (loc !== null) {
+var uniform = obj.userUniforms[attr];
+if (typeof uniform.length === "undefined")
+gl.uniform1f(loc, uniform);
+else if (typeof uniform[0].length === "undefined") {
+uniform = new Float32Array(uniform);
+switch(uniform.length) {
+case 2: gl.uniform2fv(loc, uniform); break;
+case 3: gl.uniform3fv(loc, uniform); break;
+case 4: gl.uniform4fv(loc, uniform); break;
+default: console.warn("bad uniform length");
+}
+} else if (uniform.length == 4 && uniform[0].length == 4)
+gl.uniformMatrix4fv(loc, false, new Float32Array(uniform.getAsArray()));
+else
+console.warn("unsupported uniform matrix");
+}
+}
+}
+for (pass = 0; pass < is_twosided + 1; pass++) {
+if (type === "triangles" || type === "quads" || type === "surface")
+pmode = this.getMaterial(id, (pass === 0) ? "front" : "back");
+else pmode = "filled";
+if (pmode === "culled")
+continue;
+mode = this.mode4type[type];
+if (depth_sort && pmode == "filled") {// Don't try depthsorting on wireframe or points
+var nfaces = obj.centers.length,
+z, w, frowsize;
+frowsize = Math.floor(obj.f[pass].length/nfaces);
+var depths = new Float32Array(nfaces);
+faces = new Array(nfaces);
+for(i=0; i<nfaces; i++) {
+z = this.prmvMatrix.m13*obj.centers[3*i] +
+this.prmvMatrix.m23*obj.centers[3*i+1] +
+this.prmvMatrix.m33*obj.centers[3*i+2] +
+this.prmvMatrix.m43;
+w = this.prmvMatrix.m14*obj.centers[3*i] +
+this.prmvMatrix.m24*obj.centers[3*i+1] +
+this.prmvMatrix.m34*obj.centers[3*i+2] +
+this.prmvMatrix.m44;
+depths[i] = z/w;
+faces[i] = i;
+}
+faces.sort(depthsort);
+if (type !== "spheres") {
+var f = new Uint16Array(obj.f[pass].length);
+for (i=0; i<nfaces; i++) {
+for (j=0; j<frowsize; j++) {
+f[frowsize*i + j] = obj.f[pass][frowsize*faces[i] + j];
+}
+}
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, obj.ibuf[pass]);
+gl.bufferData(gl.ELEMENT_ARRAY_BUFFER, f, gl.DYNAMIC_DRAW);
+}
+}
+if (is_twosided)
+gl.uniform1i(obj.frontLoc, pass !== 0);
+if (is_indexed && type !== "spheres") {
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, obj.ibuf[pass]);
+} else if (type === "spheres") {
+// FIX ME!
+}
+if (type === "sprites" || type === "text" || type === "quads") {
+count = count * 6/4;
+} else if (type === "surface") {
+count = obj.f[pass].length;
+}
+if (is_indexed) {
+count = obj.f[pass].length;
+if (pmode === "lines") {
+mode = "LINES";
+is_lines = true;
+} else if (pmode === "points") {
+mode = "POINTS";
+}
+}
+if (is_lines) {
+gl.lineWidth( this.getMaterial(id, "lwd") );
+}
+gl.vertexAttribPointer(this.posLoc, 3, gl.FLOAT, false, 4*obj.vOffsets.stride, 4*obj.vOffsets.vofs);
+if (is_indexed) {
+gl.drawElements(gl[mode], count, gl.UNSIGNED_SHORT, 0);
+} else {
+gl.drawArrays(gl[mode], 0, count);
+}
+}
+};
+this.drawBackground = function(id, subsceneid) {
+var gl = this.gl || this.initGL(),
+obj = this.getObj(id),
+bg, i;
+if (!obj.initialized)
+this.initObj(id);
+if (obj.colors.length) {
+bg = obj.colors[0];
+gl.clearColor(bg[0], bg[1], bg[2], bg[3]);
+gl.depthMask(true);
+gl.clear(gl.COLOR_BUFFER_BIT | gl.DEPTH_BUFFER_BIT);
+}
+if (typeof obj.quad !== "undefined") {
+this.prMatrix.makeIdentity();
+this.mvMatrix.makeIdentity();
+gl.disable(gl.BLEND);
+gl.disable(gl.DEPTH_TEST);
+gl.depthMask(false);
+for (i=0; i < obj.quad.length; i++)
+this.drawObj(obj.quad[i], subsceneid);
+}
+};
+this.drawSubscene = function(subsceneid) {
+var gl = this.gl || this.initGL(),
+obj = this.getObj(subsceneid),
+objects = this.scene.objects,
+subids = obj.objects,
+subscene_has_faces = false,
+subscene_needs_sorting = false,
+flags, i;
+if (obj.par3d.skipRedraw)
+return;
+for (i=0; i < subids.length; i++) {
+flags = objects[subids[i]].flags;
+if (typeof flags !== "undefined") {
+subscene_has_faces |= (flags & this.f_is_lit)
+& !(flags & this.f_fixed_quads);
+subscene_needs_sorting |= (flags & this.f_depth_sort);
+}
+}
+this.setViewport(subsceneid);
+if (typeof obj.backgroundId !== "undefined")
+this.drawBackground(obj.backgroundId, subsceneid);
+if (subids.length) {
+this.setprMatrix(subsceneid);
+this.setmvMatrix(subsceneid);
+if (subscene_has_faces) {
+this.setnormMatrix(subsceneid);
+if ((obj.flags & this.f_sprites_3d) &&
+typeof obj.spriteNormmat === "undefined") {
+obj.spriteNormmat = new CanvasMatrix4(this.normMatrix);
+}
+}
+if (subscene_needs_sorting)
+this.setprmvMatrix();
+gl.enable(gl.DEPTH_TEST);
+gl.depthMask(true);
+gl.disable(gl.BLEND);
+var clipids = obj.clipplanes;
+if (typeof clipids === "undefined") {
+console.warn("bad clipids");
+}
+if (clipids.length > 0) {
+this.invMatrix = new CanvasMatrix4(this.mvMatrix);
+this.invMatrix.invert();
+for (i = 0; i < clipids.length; i++)
+this.drawObj(clipids[i], subsceneid);
+}
+subids = obj.opaque;
+if (subids.length > 0) {
+for (i = 0; i < subids.length; i++) {
+this.drawObj(subids[i], subsceneid);
+}
+}
+subids = obj.transparent;
+if (subids.length > 0) {
+gl.depthMask(false);
+gl.blendFuncSeparate(gl.SRC_ALPHA, gl.ONE_MINUS_SRC_ALPHA,
+gl.ONE, gl.ONE);
+gl.enable(gl.BLEND);
+for (i = 0; i < subids.length; i++) {
+this.drawObj(subids[i], subsceneid);
+}
+}
+subids = obj.subscenes;
+for (i = 0; i < subids.length; i++) {
+this.drawSubscene(subids[i]);
+}
+}
+};
+this.relMouseCoords = function(event) {
+var totalOffsetX = 0,
+totalOffsetY = 0,
+currentElement = this.canvas;
+do {
+totalOffsetX += currentElement.offsetLeft;
+totalOffsetY += currentElement.offsetTop;
+currentElement = currentElement.offsetParent;
+}
+while(currentElement);
+var canvasX = event.pageX - totalOffsetX,
+canvasY = event.pageY - totalOffsetY;
+return {x:canvasX, y:canvasY};
+};
+this.setMouseHandlers = function() {
+var self = this, activeSubscene, handler,
+handlers = {}, drag = 0;
+handlers.rotBase = 0;
+this.screenToVector = function(x, y) {
+var viewport = this.getObj(activeSubscene).par3d.viewport,
+width = viewport.width*this.canvas.width,
+height = viewport.height*this.canvas.height,
+radius = Math.max(width, height)/2.0,
+cx = width/2.0,
+cy = height/2.0,
+px = (x-cx)/radius,
+py = (y-cy)/radius,
+plen = Math.sqrt(px*px+py*py);
+if (plen > 1.e-6) {
+px = px/plen;
+py = py/plen;
+}
+var angle = (Math.SQRT2 - plen)/Math.SQRT2*Math.PI/2,
+z = Math.sin(angle),
+zlen = Math.sqrt(1.0 - z*z);
+px = px * zlen;
+py = py * zlen;
+return [px, py, z];
+};
+handlers.trackballdown = function(x,y) {
+var activeSub = this.getObj(activeSubscene),
+activeModel = this.getObj(this.useid(activeSub.id, "model")),
+i, l = activeModel.par3d.listeners;
+handlers.rotBase = this.screenToVector(x, y);
+this.saveMat = [];
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.saveMat = new CanvasMatrix4(activeSub.par3d.userMatrix);
+}
+};
+handlers.trackballmove = function(x,y) {
+var rotCurrent = this.screenToVector(x,y),
+rotBase = handlers.rotBase,
+dot = rotBase[0]*rotCurrent[0] +
+rotBase[1]*rotCurrent[1] +
+rotBase[2]*rotCurrent[2],
+angle = Math.acos( dot/this.vlen(rotBase)/this.vlen(rotCurrent) )*180.0/Math.PI,
+axis = this.xprod(rotBase, rotCurrent),
+objects = this.scene.objects,
+activeSub = this.getObj(activeSubscene),
+activeModel = this.getObj(this.useid(activeSub.id, "model")),
+l = activeModel.par3d.listeners,
+i;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.par3d.userMatrix.load(objects[l[i]].saveMat);
+activeSub.par3d.userMatrix.rotate(angle, axis[0], axis[1], axis[2]);
+}
+this.drawScene();
+};
+handlers.trackballend = 0;
+handlers.axisdown = function(x,y) {
+handlers.rotBase = this.screenToVector(x, this.canvas.height/2);
+var activeSub = this.getObj(activeSubscene),
+activeModel = this.getObj(this.useid(activeSub.id, "model")),
+i, l = activeModel.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.saveMat = new CanvasMatrix4(activeSub.par3d.userMatrix);
+}
+};
+handlers.axismove = function(x,y) {
+var rotCurrent = this.screenToVector(x, this.canvas.height/2),
+rotBase = handlers.rotBase,
+angle = (rotCurrent[0] - rotBase[0])*180/Math.PI,
+rotMat = new CanvasMatrix4();
+rotMat.rotate(angle, handlers.axis[0], handlers.axis[1], handlers.axis[2]);
+var activeSub = this.getObj(activeSubscene),
+activeModel = this.getObj(this.useid(activeSub.id, "model")),
+i, l = activeModel.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.par3d.userMatrix.load(activeSub.saveMat);
+activeSub.par3d.userMatrix.multLeft(rotMat);
+}
+this.drawScene();
+};
+handlers.axisend = 0;
+handlers.y0zoom = 0;
+handlers.zoom0 = 0;
+handlers.zoomdown = function(x, y) {
+var activeSub = this.getObj(activeSubscene),
+activeProjection = this.getObj(this.useid(activeSub.id, "projection")),
+i, l = activeProjection.par3d.listeners;
+handlers.y0zoom = y;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.zoom0 = Math.log(activeSub.par3d.zoom);
+}
+};
+handlers.zoommove = function(x, y) {
+var activeSub = this.getObj(activeSubscene),
+activeProjection = this.getObj(this.useid(activeSub.id, "projection")),
+i, l = activeProjection.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.par3d.zoom = Math.exp(activeSub.zoom0 + (y-handlers.y0zoom)/this.canvas.height);
+}
+this.drawScene();
+};
+handlers.zoomend = 0;
+handlers.y0fov = 0;
+handlers.fovdown = function(x, y) {
+handlers.y0fov = y;
+var activeSub = this.getObj(activeSubscene),
+activeProjection = this.getObj(this.useid(activeSub.id, "projection")),
+i, l = activeProjection.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.fov0 = activeSub.par3d.FOV;
+}
+};
+handlers.fovmove = function(x, y) {
+var activeSub = this.getObj(activeSubscene),
+activeProjection = this.getObj(this.useid(activeSub.id, "projection")),
+i, l = activeProjection.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = this.getObj(l[i]);
+activeSub.par3d.FOV = Math.max(1, Math.min(179, activeSub.fov0 +
+180*(y-handlers.y0fov)/this.canvas.height));
+}
+this.drawScene();
+};
+handlers.fovend = 0;
+this.canvas.onmousedown = function ( ev ){
+if (!ev.which) // Use w3c defns in preference to MS
+switch (ev.button) {
+case 0: ev.which = 1; break;
+case 1:
+case 4: ev.which = 2; break;
+case 2: ev.which = 3;
+}
+drag = ["left", "middle", "right"][ev.which-1];
+var coords = self.relMouseCoords(ev);
+coords.y = self.canvas.height-coords.y;
+activeSubscene = self.whichSubscene(coords);
+var sub = self.getObj(activeSubscene), f;
+handler = sub.par3d.mouseMode[drag];
+switch (handler) {
+case "xAxis":
+handler = "axis";
+handlers.axis = [1.0, 0.0, 0.0];
+break;
+case "yAxis":
+handler = "axis";
+handlers.axis = [0.0, 1.0, 0.0];
+break;
+case "zAxis":
+handler = "axis";
+handlers.axis = [0.0, 0.0, 1.0];
+break;
+}
+f = handlers[handler + "down"];
+if (f) {
+coords = self.translateCoords(activeSubscene, coords);
+f.call(self, coords.x, coords.y);
+ev.preventDefault();
+}
+};
+this.canvas.onmouseup = function ( ev ){
+if ( drag === 0 ) return;
+var f = handlers[handler + "up"];
+if (f)
+f();
+drag = 0;
+};
+this.canvas.onmouseout = this.canvas.onmouseup;
+this.canvas.onmousemove = function ( ev ) {
+if ( drag === 0 ) return;
+var f = handlers[handler + "move"];
+if (f) {
+var coords = self.relMouseCoords(ev);
+coords.y = self.canvas.height - coords.y;
+coords = self.translateCoords(activeSubscene, coords);
+f.call(self, coords.x, coords.y);
+}
+};
+handlers.wheelHandler = function(ev) {
+var del = 1.02, i;
+if (ev.shiftKey) del = 1.002;
+var ds = ((ev.detail || ev.wheelDelta) > 0) ? del : (1 / del);
+if (typeof activeSubscene === "undefined")
+activeSubscene = self.scene.rootSubscene;
+var activeSub = self.getObj(activeSubscene),
+activeProjection = self.getObj(self.useid(activeSub.id, "projection")),
+l = activeProjection.par3d.listeners;
+for (i = 0; i < l.length; i++) {
+activeSub = self.getObj(l[i]);
+activeSub.par3d.zoom *= ds;
+}
+self.drawScene();
+ev.preventDefault();
+};
+this.canvas.addEventListener("DOMMouseScroll", handlers.wheelHandler, false);
+this.canvas.addEventListener("mousewheel", handlers.wheelHandler, false);
+};
+this.useid = function(subsceneid, type) {
+var sub = this.getObj(subsceneid);
+if (sub.embeddings[type] === "inherit")
+return(this.useid(sub.parent, type));
+else
+return subsceneid;
+};
+this.inViewport = function(coords, subsceneid) {
+var viewport = this.getObj(subsceneid).par3d.viewport,
+x0 = coords.x - viewport.x*this.canvas.width,
+y0 = coords.y - viewport.y*this.canvas.height;
+return 0 <= x0 && x0 <= viewport.width*this.canvas.width &&
+0 <= y0 && y0 <= viewport.height*this.canvas.height;
+};
+this.whichSubscene = function(coords) {
+var self = this,
+recurse = function(subsceneid) {
+var subscenes = self.getChildSubscenes(subsceneid), i, id;
+for (i=0; i < subscenes.length; i++) {
+id = recurse(subscenes[i]);
+if (typeof(id) !== "undefined")
+return(id);
+}
+if (self.inViewport(coords, subsceneid))
+return(subsceneid);
+else
+return undefined;
+},
+rootid = this.scene.rootSubscene,
+result = recurse(rootid);
+if (typeof(result) === "undefined")
+result = rootid;
+return result;
+};
+this.translateCoords = function(subsceneid, coords) {
+var viewport = this.getObj(subsceneid).par3d.viewport;
+return {x: coords.x - viewport.x*this.canvas.width,
+y: coords.y - viewport.y*this.canvas.height};
+};
+this.initSphere = function() {
+var verts = this.scene.sphereVerts,
+reuse = verts.reuse, result;
+if (typeof reuse !== "undefined") {
+var prev = document.getElementById(reuse).rglinstance.sphere;
+result = {values: prev.values, vOffsets: prev.vOffsets, it: prev.it};
+} else
+result = {values: new Float32Array(this.flatten(this.cbind(this.transpose(verts.vb),
+this.transpose(verts.texcoords)))),
+it: new Uint16Array(this.flatten(this.transpose(verts.it))),
+vOffsets: {vofs:0, cofs:-1, nofs:-1, radofs:-1, oofs:-1,
+tofs:3, stride:5}};
+result.sphereCount = result.it.length;
+this.sphere = result;
+};
+this.initSphereGL = function() {
+var gl = this.gl || this.initGL(), sphere = this.sphere;
+if (gl.isContextLost()) return;
+sphere.buf = gl.createBuffer();
+gl.bindBuffer(gl.ARRAY_BUFFER, sphere.buf);
+gl.bufferData(gl.ARRAY_BUFFER, sphere.values, gl.STATIC_DRAW);
+sphere.ibuf = gl.createBuffer();
+gl.bindBuffer(gl.ELEMENT_ARRAY_BUFFER, sphere.ibuf);
+gl.bufferData(gl.ELEMENT_ARRAY_BUFFER, sphere.it, gl.STATIC_DRAW);
+return;
+};
+this.initialize = function(el, x) {
+this.textureCanvas = document.createElement("canvas");
+this.textureCanvas.style.display = "block";
+this.scene = x;
+this.normMatrix = new CanvasMatrix4();
+this.saveMat = {};
+this.distance = null;
+this.posLoc = 0;
+this.colLoc = 1;
+if (el) {
+el.rglinstance = this;
+this.el = el;
+this.webGLoptions = el.rglinstance.scene.webGLoptions;
+this.initCanvas();
+}
+};
+this.restartCanvas = function() {
+var newcanvas = document.createElement("canvas");
+newcanvas.width = this.el.width;
+newcanvas.height = this.el.height;
+newcanvas.addEventListener("webglcontextrestored",
+this.onContextRestored, false);
+newcanvas.addEventListener("webglcontextlost",
+this.onContextLost, false);
+while (this.el.firstChild) {
+this.el.removeChild(this.el.firstChild);
+}
+this.el.appendChild(newcanvas);
+this.canvas = newcanvas;
+this.gl = null;
+};
+this.initCanvas = function() {
+this.restartCanvas();
+var objs = this.scene.objects,
+self = this;
+Object.keys(objs).forEach(function(key){
+var id = parseInt(key, 10),
+obj = self.getObj(id);
+if (typeof obj.reuse !== "undefined")
+self.copyObj(id, obj.reuse);
+});
+Object.keys(objs).forEach(function(key){
+self.initSubscene(parseInt(key, 10));
+});
+this.setMouseHandlers();
+this.initSphere();
+this.onContextRestored = function(event) {
+self.initGL();
+self.drawScene();
+// console.log("restored context for "+self.scene.rootSubscene);
+};
+this.onContextLost = function(event) {
+if (!self.drawing)
+self.restartCanvas();
+event.preventDefault();
+};
+this.initGL0();
+lazyLoadScene = function() {
+if (self.isInBrowserViewport()) {
+if (!self.gl) {
+self.initGL();
+}
+self.drawScene();
+}
+};
+window.addEventListener("DOMContentLoaded", lazyLoadScene, false);
+window.addEventListener("load", lazyLoadScene, false);
+window.addEventListener("resize", lazyLoadScene, false);
+window.addEventListener("scroll", lazyLoadScene, false);
+};
+/* this is only used by writeWebGL; rglwidget has
+no debug element and does the drawing in rglwidget.js */
+this.start = function() {
+if (typeof this.prefix !== "undefined") {
+this.debugelement = document.getElementById(this.prefix + "debug");
+this.debug("");
+}
+this.drag = 0;
+this.drawScene();
+};
+this.debug = function(msg, img) {
+if (typeof this.debugelement !== "undefined" && this.debugelement !== null) {
+this.debugelement.innerHTML = msg;
+if (typeof img !== "undefined") {
+this.debugelement.insertBefore(img, this.debugelement.firstChild);
+}
+} else if (msg !== "")
+alert(msg);
+};
+this.getSnapshot = function() {
+var img;
+if (typeof this.scene.snapshot !== "undefined") {
+img = document.createElement("img");
+img.src = this.scene.snapshot;
+img.alt = "Snapshot";
+}
+return img;
+};
+this.initGL0 = function() {
+if (!window.WebGLRenderingContext){
+alert("Your browser does not support WebGL. See http://get.webgl.org");
+return;
+}
+};
+this.isInBrowserViewport = function() {
+var rect = this.canvas.getBoundingClientRect(),
+windHeight = (window.innerHeight || document.documentElement.clientHeight),
+windWidth = (window.innerWidth || document.documentElement.clientWidth);
+return (
+rect.top >= -windHeight &&
+rect.left >= -windWidth &&
+rect.bottom <= 2*windHeight &&
+rect.right <= 2*windWidth);
+};
+this.initGL = function() {
+var self = this;
+if (this.gl) {
+if (!this.drawing && this.gl.isContextLost())
+this.restartCanvas();
+else
+return this.gl;
+}
+// if (!this.isInBrowserViewport()) return; Return what??? At this point we know this.gl is null.
+this.canvas.addEventListener("webglcontextrestored",
+this.onContextRestored, false);
+this.canvas.addEventListener("webglcontextlost",
+this.onContextLost, false);
+this.gl = this.canvas.getContext("webgl", this.webGLoptions) ||
+this.canvas.getContext("experimental-webgl", this.webGLoptions);
+var save = this.startDrawing();
+this.initSphereGL();
+Object.keys(this.scene.objects).forEach(function(key){
+self.initObj(parseInt(key, 10));
+});
+this.stopDrawing(save);
+return this.gl;
+};
+this.resize = function(el) {
+this.canvas.width = el.width;
+this.canvas.height = el.height;
+};
+this.drawScene = function() {
+var gl = this.gl || this.initGL(),
+save = this.startDrawing();
+gl.enable(gl.DEPTH_TEST);
+gl.depthFunc(gl.LEQUAL);
+gl.clearDepth(1.0);
+gl.clearColor(1,1,1,1);
+gl.depthMask(true); // Must be true before clearing depth buffer
+gl.clear(gl.COLOR_BUFFER_BIT | gl.DEPTH_BUFFER_BIT);
+this.drawSubscene(this.scene.rootSubscene);
+this.stopDrawing(save);
+};
+this.subsetSetter = function(el, control) {
+if (typeof control.subscenes === "undefined" ||
+control.subscenes === null)
+control.subscenes = this.scene.rootSubscene;
+var value = Math.round(control.value),
+subscenes = [].concat(control.subscenes),
+fullset = [].concat(control.fullset),
+i, j, entries, subsceneid,
+adds = [], deletes = [],
+ismissing = function(x) {
+return fullset.indexOf(x) < 0;
+},
+tointeger = function(x) {
+return parseInt(x, 10);
+};
+if (control.accumulate)
+for (i=0; i <= value; i++)
+adds = adds.concat(control.subsets[i]);
+else
+adds = adds.concat(control.subsets[value]);
+deletes = fullset.filter(function(x) { return adds.indexOf(x) < 0 });
+for (i = 0; i < subscenes.length; i++) {
+subsceneid = subscenes[i];
+if (typeof this.getObj(subsceneid) === "undefined")
+this.alertOnce("typeof object is undefined");
+for (j = 0; j < adds.length; j++)
+this.addToSubscene(adds[j], subsceneid);
+for (j = 0; j < deletes.length; j++)
+this.delFromSubscene(deletes[j], subsceneid);
+}
+};
+this.propertySetter = function(el, control) {
+var value = control.value,
+values = [].concat(control.values),
+svals = [].concat(control.param),
+direct = values[0] === null,
+entries = [].concat(control.entries),
+ncol = entries.length,
+nrow = values.length/ncol,
+properties = this.repeatToLen(control.properties, ncol),
+objids = this.repeatToLen(control.objids, ncol),
+property, objid = objids[0],
+obj = this.getObj(objid),
+propvals, i, v1, v2, p, entry, gl, needsBinding,
+newprop, newid,
+getPropvals = function() {
+if (property === "userMatrix")
+return obj.par3d.userMatrix.getAsArray();
+else if (property === "scale" || property === "FOV" || property === "zoom")
+return [].concat(obj.par3d[property]);
+else
+return [].concat(obj[property]);
+};
+putPropvals = function(newvals) {
+if (newvals.length == 1)
+newvals = newvals[0];
+if (property === "userMatrix")
+obj.par3d.userMatrix.load(newvals);
+else if (property === "scale" || property === "FOV" || property === "zoom")
+obj.par3d[property] = newvals;
+else
+obj[property] = newvals;
+}
+if (direct && typeof value === "undefined")
+return;
+if (control.interp) {
+values = values.slice(0, ncol).concat(values).
+concat(values.slice(ncol*(nrow-1), ncol*nrow));
+svals = [-Infinity].concat(svals).concat(Infinity);
+for (i = 1; i < svals.length; i++) {
+if (value <= svals[i]) {
+if (svals[i] === Infinity)
+p = 1;
+else
+p = (svals[i] - value)/(svals[i] - svals[i-1]);
+break;
+}
+}
+} else if (!direct) {
+value = Math.round(value);
+}
+for (j=0; j<entries.length; j++) {
+entry = entries[j];
+newprop = properties[j];
+newid = objids[j];
+if (newprop !== property || newid != objid) {
+if (typeof property !== "undefined")
+putPropvals(propvals);
+property = newprop;
+objid = newid;
+obj = this.getObj(objid);
+propvals = getPropvals();
+}
+if (control.interp) {
+v1 = values[ncol*(i-1) + j];
+v2 = values[ncol*i + j];
+this.setElement(propvals, entry, p*v1 + (1-p)*v2);
+} else if (!direct) {
+this.setElement(propvals, entry, values[ncol*value + j]);
+} else {
+this.setElement(propvals, entry, value[j]);
+}
+}
+putPropvals(propvals);
+needsBinding = [];
+for (j=0; j < entries.length; j++) {
+if (properties[j] === "values" &&
+needsBinding.indexOf(objids[j]) === -1) {
+needsBinding.push(objids[j]);
+}
+}
+for (j=0; j < needsBinding.length; j++) {
+gl = this.gl || this.initGL();
+obj = this.getObj(needsBinding[j]);
+gl.bindBuffer(gl.ARRAY_BUFFER, obj.buf);
+gl.bufferData(gl.ARRAY_BUFFER, obj.values, gl.STATIC_DRAW);
+}
+};
+this.vertexSetter = function(el, control) {
+var svals = [].concat(control.param),
+j, k, p, propvals, stride, ofs, obj,
+attrib,
+ofss = {x:"vofs", y:"vofs", z:"vofs",
+red:"cofs", green:"cofs", blue:"cofs",
+alpha:"cofs", radii:"radofs",
+nx:"nofs", ny:"nofs", nz:"nofs",
+ox:"oofs", oy:"oofs", oz:"oofs",
+ts:"tofs", tt:"tofs"},
+pos = {x:0, y:1, z:2,
+red:0, green:1, blue:2,
+alpha:3,radii:0,
+nx:0, ny:1, nz:2,
+ox:0, oy:1, oz:2,
+ts:0, tt:1},
+values = control.values,
+direct = values === null,
+ncol,
+interp = control.interp,
+vertices = [].concat(control.vertices),
+attributes = [].concat(control.attributes),
+value = control.value;
+ncol = Math.max(vertices.length, attributes.length);
+if (!ncol)
+return;
+vertices = this.repeatToLen(vertices, ncol);
+attributes = this.repeatToLen(attributes, ncol);
+if (direct)
+interp = false;
+/* JSON doesn't pass Infinity */
+svals[0] = -Infinity;
+svals[svals.length - 1] = Infinity;
+for (j = 1; j < svals.length; j++) {
+if (value <= svals[j]) {
+if (interp) {
+if (svals[j] === Infinity)
+p = 1;
+else
+p = (svals[j] - value)/(svals[j] - svals[j-1]);
+} else {
+if (svals[j] - value > value - svals[j-1])
+j = j - 1;
+}
+break;
+}
+}
+obj = this.getObj(control.objid);
+propvals = obj.values;
+for (k=0; k<ncol; k++) {
+attrib = attributes[k];
+vertex = vertices[k];
+ofs = obj.vOffsets[ofss[attrib]];
+if (ofs < 0)
+this.alertOnce("Attribute '"+attrib+"' not found in object "+control.objid);
+else {
+stride = obj.vOffsets.stride;
+ofs = vertex*stride + ofs + pos[attrib];
+if (direct) {
+propvals[ofs] = value;
+} else if (interp) {
+propvals[ofs] = p*values[j-1][k] + (1-p)*values[j][k];
+} else {
+propvals[ofs] = values[j][k];
+}
+}
+}
+if (typeof obj.buf !== "undefined") {
+var gl = this.gl || this.initGL();
+gl.bindBuffer(gl.ARRAY_BUFFER, obj.buf);
+gl.bufferData(gl.ARRAY_BUFFER, propvals, gl.STATIC_DRAW);
+}
+};
+this.ageSetter = function(el, control) {
+var objids = [].concat(control.objids),
+nobjs = objids.length,
+time = control.value,
+births = [].concat(control.births),
+ages = [].concat(control.ages),
+steps = births.length,
+j = Array(steps),
+p = Array(steps),
+i, k, age, j0, propvals, stride, ofs, objid, obj,
+attrib, dim,
+attribs = ["colors", "alpha", "radii", "vertices",
+"normals", "origins", "texcoords",
+"x", "y", "z",
+"red", "green", "blue"],
+ofss = ["cofs", "cofs", "radofs", "vofs",
+"nofs", "oofs", "tofs",
+"vofs", "vofs", "vofs",
+"cofs", "cofs", "cofs"],
+dims = [3,1,1,3,
+3,2,2,
+1,1,1,
+1,1,1],
+pos = [0,3,0,0,
+0,0,0,
+0,1,2,
+0,1,2];
+/* Infinity doesn't make it through JSON */
+ages[0] = -Infinity;
+ages[ages.length-1] = Infinity;
+for (i = 0; i < steps; i++) {
+if (births[i] !== null) { // NA in R becomes null
+age = time - births[i];
+for (j0 = 1; age > ages[j0]; j0++);
+if (ages[j0] == Infinity)
+p[i] = 1;
+else if (ages[j0] > ages[j0-1])
+p[i] = (ages[j0] - age)/(ages[j0] - ages[j0-1]);
+else
+p[i] = 0;
+j[i] = j0;
+}
+}
+for (l = 0; l < nobjs; l++) {
+objid = objids[l];
+obj = this.getObj(objid);
+if (typeof obj.vOffsets === "undefined")
+continue;
+propvals = obj.values;
+stride = obj.vOffsets.stride;
+for (k = 0; k < attribs.length; k++) {
+attrib = control[attribs[k]];
+if (typeof attrib !== "undefined") {
+ofs = obj.vOffsets[ofss[k]];
+if (ofs >= 0) {
+dim = dims[k];
+ofs = ofs + pos[k];
+for (i = 0; i < steps; i++) {
+if (births[i] !== null) {
+for (d=0; d < dim; d++) {
+propvals[i*stride + ofs + d] = p[i]*attrib[dim*(j[i]-1) + d] + (1-p[i])*attrib[dim*j[i] + d];
+}
+}
+}
+} else
+this.alertOnce("\'"+attribs[k]+"\' property not found in object "+objid);
+}
+}
+obj.values = propvals;
+if (typeof obj.buf !== "undefined") {
+gl = this.gl || this.initGL();
+gl.bindBuffer(gl.ARRAY_BUFFER, obj.buf);
+gl.bufferData(gl.ARRAY_BUFFER, obj.values, gl.STATIC_DRAW);
+}
+}
+};
+this.oldBridge = function(el, control) {
+var attrname, global = window[control.prefix + "rgl"];
+if (typeof global !== "undefined")
+for (attrname in global)
+this[attrname] = global[attrname];
+window[control.prefix + "rgl"] = this;
+};
+this.Player = function(el, control) {
+var
+self = this,
+components = [].concat(control.components),
+buttonLabels = [].concat(control.buttonLabels),
+Tick = function() { /* "this" will be a timer */
+var i,
+nominal = this.value,
+slider = this.Slider,
+labels = this.outputLabels,
+output = this.Output,
+step;
+if (typeof slider !== "undefined" && nominal != slider.value)
+slider.value = nominal;
+if (typeof output !== "undefined") {
+step = Math.round((nominal - output.sliderMin)/output.sliderStep);
+if (labels !== null) {
+output.innerHTML = labels[step];
+} else {
+step = step*output.sliderStep + output.sliderMin;
+output.innerHTML = step.toPrecision(output.outputPrecision);
+}
+}
+for (i=0; i < this.actions.length; i++) {
+this.actions[i].value = nominal;
+}
+self.applyControls(el, this.actions, false);
+self.drawScene();
+},
+OnSliderInput = function() { /* "this" will be the slider */
+this.rgltimer.value = Number(this.value);
+this.rgltimer.Tick();
+},
+addSlider = function(min, max, step, value) {
+var slider = document.createElement("input");
+slider.type = "range";
+slider.min = min;
+slider.max = max;
+slider.step = step;
+slider.value = value;
+slider.oninput = OnSliderInput;
+slider.sliderActions = control.actions;
+slider.sliderScene = this;
+slider.className = "rgl-slider";
+slider.id = el.id + "-slider";
+el.rgltimer.Slider = slider;
+slider.rgltimer = el.rgltimer;
+el.appendChild(slider);
+},
+addLabel = function(labels, min, step, precision) {
+var output = document.createElement("output");
+output.sliderMin = min;
+output.sliderStep = step;
+output.outputPrecision = precision;
+output.className = "rgl-label";
+output.id = el.id + "-label";
+el.rgltimer.Output = output;
+el.rgltimer.outputLabels = labels;
+el.appendChild(output);
+},
+addButton = function(which, label, active) {
+var button = document.createElement("input"),
+onclicks = {Reverse: function() { this.rgltimer.reverse();},
+Play: function() { this.rgltimer.play();
+this.value = this.rgltimer.enabled ? this.inactiveValue : this.activeValue; },
+Slower: function() { this.rgltimer.slower(); },
+Faster: function() { this.rgltimer.faster(); },
+Reset: function() { this.rgltimer.reset(); },
+Step: function() { this.rgltimer.step(); }
+};
+button.rgltimer = el.rgltimer;
+button.type = "button";
+button.value = label;
+button.activeValue = label;
+button.inactiveValue = active;
+if (which === "Play")
+button.rgltimer.PlayButton = button;
+button.onclick = onclicks[which];
+button.className = "rgl-button";
+button.id = el.id + "-" + which;
+el.appendChild(button);
+};
+if (typeof control.reinit !== "undefined" && control.reinit !== null) {
+control.actions.reinit = control.reinit;
+}
+el.rgltimer = new rgltimerClass(Tick, control.start, control.interval, control.stop,
+control.step, control.value, control.rate, control.loop, control.actions);
+for (var i=0; i < components.length; i++) {
+switch(components[i]) {
+case "Slider": addSlider(control.start, control.stop,
+control.step, control.value);
+break;
+case "Label": addLabel(control.labels, control.start,
+control.step, control.precision);
+break;
+default:
+addButton(components[i], buttonLabels[i], control.pause);
+}
+}
+el.rgltimer.Tick();
+};
+this.applyControls = function(el, x, draw) {
+var self = this, reinit = x.reinit, i, control, type;
+for (i = 0; i < x.length; i++) {
+control = x[i];
+type = control.type;
+self[type](el, control);
+}
+if (typeof reinit !== "undefined" && reinit !== null) {
+reinit = [].concat(reinit);
+for (i = 0; i < reinit.length; i++)
+self.getObj(reinit[i]).initialized = false;
+}
+if (typeof draw === "undefined" || draw)
+self.drawScene();
+};
+this.sceneChangeHandler = function(message) {
+var self = document.getElementById(message.elementId).rglinstance,
+objs = message.objects, mat = message.material,
+root = message.rootSubscene,
+initSubs = message.initSubscenes,
+redraw = message.redrawScene,
+skipRedraw = message.skipRedraw,
+deletes, subs, allsubs = [], i,j;
+if (typeof message.delete !== "undefined") {
+deletes = [].concat(message.delete);
+if (typeof message.delfromSubscenes !== "undefined")
+subs = [].concat(message.delfromSubscenes);
+else
+subs = [];
+for (i = 0; i < deletes.length; i++) {
+for (j = 0; j < subs.length; j++) {
+self.delFromSubscene(deletes[i], subs[j]);
+}
+delete self.scene.objects[deletes[i]];
+}
+}
+if (typeof objs !== "undefined") {
+Object.keys(objs).forEach(function(key){
+key = parseInt(key, 10);
+self.scene.objects[key] = objs[key];
+self.initObj(key);
+var obj = self.getObj(key),
+subs = [].concat(obj.inSubscenes), k;
+allsubs = allsubs.concat(subs);
+for (k = 0; k < subs.length; k++)
+self.addToSubscene(key, subs[k]);
+});
+}
+if (typeof mat !== "undefined") {
+self.scene.material = mat;
+}
+if (typeof root !== "undefined") {
+self.scene.rootSubscene = root;
+}
+if (typeof initSubs !== "undefined")
+allsubs = allsubs.concat(initSubs);
+allsubs = self.unique(allsubs);
+for (i = 0; i < allsubs.length; i++) {
+self.initSubscene(allsubs[i]);
+}
+if (typeof skipRedraw !== "undefined") {
+root = self.getObj(self.scene.rootSubscene);
+root.par3d.skipRedraw = skipRedraw;
+}
+if (redraw)
+self.drawScene();
+};
+}).call(rglwidgetClass.prototype);
+rgltimerClass = function(Tick, startTime, interval, stopTime, stepSize, value, rate, loop, actions) {
+this.enabled = false;
+this.timerId = 0;
+this.startTime = startTime; /* nominal start time in seconds */
+this.value = value; /* current nominal time */
+this.interval = interval; /* seconds between updates */
+this.stopTime = stopTime; /* nominal stop time */
+this.stepSize = stepSize; /* nominal step size */
+this.rate = rate; /* nominal units per second */
+this.loop = loop; /* "none", "cycle", or "oscillate" */
+this.realStart = undefined; /* real world start time */
+this.multiplier = 1; /* multiplier for fast-forward
+or reverse */
+this.actions = actions;
+this.Tick = Tick;
+};
+(function() {
+this.play = function() {
+if (this.enabled) {
+this.enabled = false;
+window.clearInterval(this.timerId);
+this.timerId = 0;
+return;
+}
+var tick = function(self) {
+var now = new Date();
+self.value = self.multiplier*self.rate*(now - self.realStart)/1000 + self.startTime;
+self.forceToRange();
+if (typeof self.Tick !== "undefined") {
+self.Tick(self.value);
+}
+};
+this.realStart = new Date() - 1000*(this.value - this.startTime)/this.rate/this.multiplier;
+this.timerId = window.setInterval(tick, 1000*this.interval, this);
+this.enabled = true;
+};
+this.forceToRange = function() {
+if (this.value > this.stopTime + this.stepSize/2 || this.value < this.startTime - this.stepSize/2) {
+if (!this.loop) {
+this.reset();
+} else {
+var cycle = this.stopTime - this.startTime + this.stepSize,
+newval = (this.value - this.startTime) % cycle + this.startTime;
+if (newval < this.startTime) {
+newval += cycle;
+}
+this.realStart += (this.value - newval)*1000/this.multiplier/this.rate;
+this.value = newval;
+}
+}
+}
+this.reset = function() {
+this.value = this.startTime;
+this.newmultiplier(1);
+if (typeof this.Tick !== "undefined") {
+this.Tick(this.value);
+}
+if (this.enabled)
+this.play(); /* really pause... */
+if (typeof this.PlayButton !== "undefined")
+this.PlayButton.value = "Play";
+};
+this.faster = function() {
+this.newmultiplier(Math.SQRT2*this.multiplier);
+};
+this.slower = function() {
+this.newmultiplier(this.multiplier/Math.SQRT2);
+};
+this.reverse = function() {
+this.newmultiplier(-this.multiplier);
+};
+this.newmultiplier = function(newmult) {
+if (newmult != this.multiplier) {
+this.realStart += 1000*(this.value - this.startTime)/this.rate*(1/this.multiplier - 1/newmult);
+this.multiplier = newmult;
+}
+};
+this.step = function() {
+this.value += this.rate*this.multiplier;
+this.forceToRange();
+if (typeof this.Tick !== "undefined")
+this.Tick(this.value);
+}
+}).call(rgltimerClass.prototype);</script>
+<div id="plot_3Ddiv" class="rglWebGL">
+
+</div>
+<script type="text/javascript">
+var plot_3Ddiv = document.getElementById("plot_3Ddiv"),
+plot_3Drgl = new rglwidgetClass();
+plot_3Ddiv.width = 673;
+plot_3Ddiv.height = 673;
+plot_3Drgl.initialize(plot_3Ddiv,
+{"material":{"color":"#000000","alpha":1,"lit":true,"ambient":"#000000","specular":"#FFFFFF","emission":"#000000","shininess":50,"smooth":true,"front":"filled","back":"filled","size":3,"lwd":1,"fog":false,"point_antialias":false,"line_antialias":false,"texture":null,"textype":"rgb","texmipmap":false,"texminfilter":"linear","texmagfilter":"linear","texenvmap":false,"depth_mask":true,"depth_test":"less","isTransparent":false},"rootSubscene":1,"objects":{"7":{"id":7,"type":"spheres","materi [...]
+plot_3Drgl.prefix = "plot_3D";
+</script>
+<p id="plot_3Ddebug">
+You must enable Javascript to view this page properly.
+</p>
+<script>plot_3Drgl.start();</script>
+</div>
+<div id="treespace-analysis" class="section level2">
+<h2><em>treespace</em> analysis</h2>
+<p>From these plots we can see that <em>treespace</em> has identified variation in the trees according to the Kendall Colijn metric (<span class="math inline">\(\lambda=0\)</span>, ignoring branch lengths). The NJ and ML bootstrap trees have broadly similar topologies but are different from any of the BEAST trees. We can check whether any bootstrap trees have the same topology as either the NJ or ML tree, as follows:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># trees with the same topology as the NJ tree:</span>
+<span class="kw">which</span>(<span class="kw">as.matrix</span>(Dscape$D)[<span class="st">"NJ"</span>,]==<span class="dv">0</span>)</code></pre></div>
+<pre><code>## NJ_boots91 NJ
+## 291 401</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># trees with the same topology as the ML tree:</span>
+<span class="kw">which</span>(<span class="kw">as.matrix</span>(Dscape$D)[<span class="st">"ML"</span>,]==<span class="dv">0</span>)</code></pre></div>
+<pre><code>## ML_boots1 ML_boots6 ML_boots26 ML_boots40 ML_boots43 ML_boots48
+## 301 306 326 340 343 348
+## ML_boots51 ML_boots62 ML_boots65 ML_boots69 ML_boots70 ML_boots76
+## 351 362 365 369 370 376
+## ML_boots79 ML
+## 379 402</code></pre>
+<p>This shows that the NJ tree has the same topology as one NJ bootstrap tree and one ML bootstrap tree. The ML tree has the same topology as 15 ML bootstrap trees, but no NJ bootstrap trees.</p>
+<p>We can compare pairs of trees using the <code>plotTreeDiff</code> function to see exactly where their differences arise. Tips with identical ancestry in the two trees are coloured grey, whereas tips with differing ancestry are coloured peach-red, with the colour darkening according to the number of ancestral differences found at each tip. Since we are comparing the trees topologically (ignoring branch lengths, for the moment), we plot with constant branch lengths for clarity.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># comparing NJ and ML:</span>
+<span class="kw">plotTreeDiff</span>(DnjRooted,DfitTreeRooted, <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeWwcSX4v+G9E1n2zWLzvQyRFXdQtdavV13RPq4+d8Xjs6WnM9jy/9XqBheHxLgy8tzC8a7yHtY218bCHAcODgb1YA7PjN56do21P9/Trbk339KGTah3UTYpXFVnFuu+qzIj9I4t1kBQl9VAHS7/PX6zIyMhgQclvRmRkikkpQQghhJD6wh92BwghhBCy8SjgCSGEkDpEAU8IIYTUIQp4QgghpA5RwBNCCCF1iAKeEEIIqUMU8IQQQkgdooAnhBBC6hAFPCGEEFKHKOAJIYSQOkQBTwghhNQhCnhCCCGkDlHAE0IIIXWIAp4QQgipQxTwhBBCSB2igCeEEELqEAU8IYQQUoco4AkhhJA6ZHjYHSDkrgghP [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">treeDist</span>(DnjRooted,DfitTreeRooted)</code></pre></div>
+<pre><code>## [1] 13.93</code></pre>
+<p>For pairwise comparisons it is helpful to find a small number of representative trees. We can find a geometric median tree from the BEAST trees using the <code>medTree</code> function:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">BEASTmed <-<span class="st"> </span><span class="kw">medTree</span>(BEASTtrees)</code></pre></div>
+<p>There are two median trees, with identical topology:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">BEASTmed$trees</code></pre></div>
+<pre><code>## 2 phylogenetic trees</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">treeDist</span>(BEASTmed$trees[[<span class="dv">1</span>]],BEASTmed$trees[[<span class="dv">2</span>]])</code></pre></div>
+<pre><code>## [1] 0</code></pre>
+<p>so we may select one of them as a BEAST representative tree. Note that for a more thorough analysis it may be appropriate to identify clusters among the BEAST trees and select a summary tree from each cluster: we demonstrate this approach later in the vignette.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">BEASTrep <-<span class="st"> </span>BEASTmed$trees[[<span class="dv">1</span>]]</code></pre></div>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># comparing BEAST median and NJ:</span>
+<span class="kw">plotTreeDiff</span>(BEASTrep,DnjRooted, <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeXhUVZ4//vddal+ykIUAWUhYwg5hDQ2ooG2Ltth+nQZRUcQ28XEaHGf0q4+KOozYTtN240ZLaztqNy7pbwM6Kr+mgRlFRSoBQsLWGJAtIXtqv7fu9vvjVqoqRUwCBkKKz+vJH6lT5557Uk9u3vcsVWE0TQMhhBBCEgvb1x0ghBBCSO+jgCeEEEISEAU8IYQQkoAo4AkhhJAERAFPCCGEJCAKeEIIISQBUcATQgghCYgCnhBCCElAFPCEEEJIAqKAJ4QQQhIQBTwhhBCSgCjgCSGEkAREAU8IIYQkIAp4QgghJAFRwBNCCCEJiAKeEEIISUB8X3eAkJ7RVNRsg6a1P2ZgtMGRhZQ8MEwPDtdQsw2aGi3hD [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">treeDist</span>(BEASTrep,DnjRooted)</code></pre></div>
+<pre><code>## [1] 13.27</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># comparing BEAST median and ML:</span>
+<span class="kw">plotTreeDiff</span>(BEASTrep,DfitTreeRooted, <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeXhb130n/O8592InCW7gvpMitUuUbMvabMubZMuOHcexE49jt308Sdo0cTNN23nHTd/pvE3T1GmbPJkkM33SpvE407SpI9ex5cabLFm2ZVuLtZGiKK4iARIACRIAQSz3nvP+cUEABClqsVbo93n0B3Huuece4hHwxVkuyKSUIIQQQkhu4Ve6A4QQQgi5+CjgCSGEkBxEAU8IIYTkIAp4QgghJAdRwBNCCCE5iAKeEEIIyUEU8IQQQkgOooAnhBBCchAFPCGEEJKDKOAJIYSQHEQBTwghhOQgCnhCCCEkB1HAE0IIITmIAp4QQgjJQRTwhBBCSA6igCeEEEJykHqlO0DIudG0xHPPQojkQ8aYs4S3LOcr1 [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">treeDist</span>(BEASTrep,DfitTreeRooted)</code></pre></div>
+<pre><code>## [1] 9.487</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># comparing BEAST median to a random BEAST tree:</span>
+num <-<span class="st"> </span><span class="kw">runif</span>(<span class="dv">1</span>,<span class="dv">1</span>,<span class="dv">200</span>)
+randomBEASTtree <-<span class="st"> </span>BEASTtrees[[num]]
+<span class="kw">plotTreeDiff</span>(BEASTrep, randomBEASTtree, <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdSWwbWZ4n/l8wGCIVIiluEilRC7VRVmpJy85yKqtkV1WjL71MA9OnRqHRg0H3LJeuavQAjTk0+lKHwsxtgJk5dgMFDDBAXQpoYC41A/9hVGVXOctWpiXRomWLlkSKIsXFjGBwCTIi/oeXGRVJybRsKbXQ389Jego+PtP6xe+934sIcYZhEAAAAHQX22UPAAAAAM4fEjwAAEAXQoIHAADoQkjwAAAAXQgJHgAAoAshwQMAAHQhJHgAAIAuhAQPAADQhZDgAQAAuhASPAAAQBdCggcAAOhCSPAAAABdCAkeAACgCyHBAwAAdCEkeAAAgC6EBA8AANCF7Jc9AIBT0XX9wYMHhmGwbzmOE0UxFAqNjY1xHPfGl [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">treeDist</span>(BEASTrep,randomBEASTtree)</code></pre></div>
+<pre><code>## [1] 4</code></pre>
+</div>
+<div id="using-treespace-to-analyse-the-beast-trees-in-more-detail" class="section level2">
+<h2>Using <em>treespace</em> to analyse the BEAST trees in more detail:</h2>
+<p>We used TreeAnnotator (Drummond and Rambaut, 2007) to create a Maximum Clade Credibility (MCC) tree from amongst the BEAST trees.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># load the MCC tree</span>
+<span class="kw">data</span>(DengueBEASTMCC)
+<span class="co"># concatenate with other BEAST trees</span>
+BEAST201 <-<span class="st"> </span><span class="kw">c</span>(BEASTtrees, DengueBEASTMCC)
+<span class="co"># compare using treespace:</span>
+BEASTscape <-<span class="st"> </span><span class="kw">treespace</span>(BEAST201, <span class="dt">nf=</span><span class="dv">5</span>)
+<span class="co"># simple plot:</span>
+<span class="kw">plotGrovesD3</span>(BEASTscape$pco)</code></pre></div>
+<div id="htmlwidget-af676447930037529a00" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-af676447930037529a00">{"x":{"data":{"x":[-1.60631706816047,2.48337509510479,-7.36755306203306,8.34533183821898,0.136513559651321,9.57372786945926,-1.42059789837214,2.32232313639973,-0.964326508817161,-3.83000409573212,-1.70804845933967,-1.60423105569205,2.4833750951048,-3.81764229081303,-3.56362732807536,5.4601309937797,1.04121623542651,0.742694577345446,-3.61665868708864,-1.654290964406,1.57815652432255,2.23418598640195,7.017242524584 [...]
+<p>There appear to be clusters of tree topologies within the BEAST trees. We can use the function <code>findGroves</code> to identify clusters:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># find clusters or 'groves':</span>
+BEASTGroves <-<span class="st"> </span><span class="kw">findGroves</span>(BEASTscape, <span class="dt">nclust=</span><span class="dv">4</span>, <span class="dt">clustering =</span> <span class="st">"single"</span>)</code></pre></div>
+<p>and to find a median tree per cluster:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># find median tree(s) per cluster:</span>
+BEASTMeds <-<span class="st"> </span><span class="kw">medTree</span>(BEAST201, <span class="dt">groups=</span>BEASTGroves$groups)
+<span class="co"># for each cluster, select a single median tree to represent it:</span>
+BEASTMedTrees <-<span class="st"> </span><span class="kw">c</span>(BEASTMeds$<span class="st">`</span><span class="dt">1</span><span class="st">`</span>$trees[[<span class="dv">1</span>]],
+ BEASTMeds$<span class="st">`</span><span class="dt">2</span><span class="st">`</span>$trees[[<span class="dv">1</span>]],
+ BEASTMeds$<span class="st">`</span><span class="dt">3</span><span class="st">`</span>$trees[[<span class="dv">1</span>]],
+ BEASTMeds$<span class="st">`</span><span class="dt">4</span><span class="st">`</span>$trees[[<span class="dv">1</span>]])</code></pre></div>
+<p>We can now make the plot again, highlighting the MCC tree and the four median trees:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># extract the numbers from the tree list 'BEASTtrees' which correspond to the median trees: </span>
+BEASTMedTreeNums <-<span class="kw">c</span>(<span class="kw">which</span>(BEASTGroves$groups==<span class="dv">1</span>)[[BEASTMeds$<span class="st">`</span><span class="dt">1</span><span class="st">`</span>$treenumbers[[<span class="dv">1</span>]]]],
+ <span class="kw">which</span>(BEASTGroves$groups==<span class="dv">2</span>)[[BEASTMeds$<span class="st">`</span><span class="dt">2</span><span class="st">`</span>$treenumbers[[<span class="dv">1</span>]]]],
+ <span class="kw">which</span>(BEASTGroves$groups==<span class="dv">3</span>)[[BEASTMeds$<span class="st">`</span><span class="dt">3</span><span class="st">`</span>$treenumbers[[<span class="dv">1</span>]]]],
+ <span class="kw">which</span>(BEASTGroves$groups==<span class="dv">4</span>)[[BEASTMeds$<span class="st">`</span><span class="dt">4</span><span class="st">`</span>$treenumbers[[<span class="dv">1</span>]]]])
+<span class="co"># prepare a vector to highlight median and MCC trees</span>
+highlightTrees <-<span class="st"> </span><span class="kw">rep</span>(<span class="dv">1</span>,<span class="dv">201</span>)
+highlightTrees[[<span class="dv">201</span>]] <-<span class="st"> </span><span class="dv">2</span>
+highlightTrees[BEASTMedTreeNums] <-<span class="st"> </span><span class="dv">2</span>
+<span class="co"># prepare colours:</span>
+BEASTcols <-<span class="st"> </span><span class="kw">c</span>(<span class="st">"#66c2a5"</span>,<span class="st">"#fc8d62"</span>,<span class="st">"#8da0cb"</span>,<span class="st">"#e78ac3"</span>)
+
+<span class="co"># plot:</span>
+<span class="kw">plotGrovesD3</span>(BEASTscape$pco,
+ <span class="dt">groups=</span><span class="kw">as.vector</span>(BEASTGroves$groups),
+ <span class="dt">colors=</span>BEASTcols,
+ <span class="dt">col_lab=</span><span class="st">"Cluster"</span>,
+ <span class="dt">symbol_var =</span> highlightTrees,
+ <span class="dt">size_range =</span> <span class="kw">c</span>(<span class="dv">60</span>,<span class="dv">600</span>),
+ <span class="dt">size_var =</span> highlightTrees,
+ <span class="dt">legend_width=</span><span class="dv">0</span>)</code></pre></div>
+<div id="htmlwidget-d952fbe419e23fb4abe5" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-d952fbe419e23fb4abe5">{"x":{"data":{"x":[-1.60631706816047,2.48337509510479,-7.36755306203306,8.34533183821898,0.136513559651321,9.57372786945926,-1.42059789837214,2.32232313639973,-0.964326508817161,-3.83000409573212,-1.70804845933967,-1.60423105569205,2.4833750951048,-3.81764229081303,-3.56362732807536,5.4601309937797,1.04121623542651,0.742694577345446,-3.61665868708864,-1.654290964406,1.57815652432255,2.23418598640195,7.017242524584 [...]
+<p>To understand the differences between the representative trees we can use <code>plotTreeDiff</code> again, for example:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># differences between the MCC tree and the median from the largest cluster:</span>
+<span class="kw">treeDist</span>(DengueBEASTMCC,BEASTMedTrees[[<span class="dv">1</span>]])</code></pre></div>
+<pre><code>## [1] 2</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotTreeDiff</span>(DengueBEASTMCC,BEASTMedTrees[[<span class="dv">1</span>]], <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeXwbZ504/s9ckqzbtmzZli3LdxwfTeKmTVInNGw5esBS2G2hXcpNudry6wLL7nItu0tZYFmuQll2KS1Xofy4ylG20NA0aUsSx21sK3ac2JFt2Zasw5rROZqZ5/vHk0wV2XGcxrnUz/vVP6xHzzx6pGb0eZ7P88yIIYQAQgghhEoLe7E7gBBCCKG1hwEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkEY4BFCCKEShAEeIYQQKkH8xe4AQquiadru3 [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># differences between the median trees from clusters 1 and 2:</span>
+<span class="kw">treeDist</span>(BEASTMedTrees[[<span class="dv">1</span>]],BEASTMedTrees[[<span class="dv">2</span>]])</code></pre></div>
+<pre><code>## [1] 10.63</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotTreeDiff</span>(BEASTMedTrees[[<span class="dv">1</span>]],BEASTMedTrees[[<span class="dv">2</span>]], <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdeXBcVXo3/u9z7u2W1Nr3fbHlVV7kRRaYwRs7XiDgwY6BEGCGYSbJJHkzqSwV8qs3L0kNNfX+3voVqUpI3gyZQJHBLAbDgI1XDMa7jRchbMuSJUstq1tSS91au/vec35/3FarJduSbcmL2s/nL/e5554+fctPP/csfUVKKTDGGGMsuohb3QHGGGOMjT9O8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU4gTPGGOMRSFO8IwxxlgU0m91Bxi7Okqid [...]
+</div>
+<div id="references" class="section level2">
+<h2>References</h2>
+<p>[1] Drummond, A. J., and Rambaut, A. (2007) BEAST: Bayesian evolutionary analysis by sampling trees. BMC Evolutionary Biology, 7(1), 214.</p>
+<p>[2] Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997) Molecular evolution and phylogeny of dengue-4 viruses. Journal of General Virology, 78(9), 2279-2286.</p>
+</div>
+
+
+
+<!-- dynamically load mathjax for compatibility with self-contained -->
+<script>
+ (function () {
+ var script = document.createElement("script");
+ script.type = "text/javascript";
+ script.src = "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
+ document.getElementsByTagName("head")[0].appendChild(script);
+ })();
+</script>
+
+</body>
+</html>
diff --git a/inst/doc/TransmissionTreesVignette.R b/inst/doc/TransmissionTreesVignette.R
new file mode 100644
index 0000000..38ff4d7
--- /dev/null
+++ b/inst/doc/TransmissionTreesVignette.R
@@ -0,0 +1,132 @@
+## ----setup, echo=FALSE---------------------------------------------------
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+
+## ----load, message=FALSE-------------------------------------------------
+library(treespace)
+
+## ----tree1---------------------------------------------------------------
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+tree1
+
+## ----igraph_tree1, message=FALSE-----------------------------------------
+library(igraph)
+# set plotting options:
+igraph_options(vertex.size=15,
+ vertex.color="cyan",
+ vertex.label.cex=2,
+ edge.color="lightgrey",
+ edge.arrow.size=1)
+
+tree1graph <- graph_from_edgelist(tree1)
+plot(tree1graph)
+
+## ----simple_wiwMRCIs-----------------------------------------------------
+findMRCIs(tree1)
+
+## ----trees2_and_3--------------------------------------------------------
+# a second scenario:
+tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+tree2
+tree2graph <- graph_from_edgelist(tree2)
+plot(tree2graph)
+
+# and a third scenario:
+tree3 <- cbind(Infector=c(2,2,2,2,6),Infectee=c(1,3,4,6,5))
+tree3
+tree3graph <- graph_from_edgelist(tree3)
+plot(tree3graph)
+
+## ----tree123_comparison--------------------------------------------------
+m1 <- findMRCIs(tree1) # find the source case, MRCIs and MRCI depths for tree 1
+m2 <- findMRCIs(tree2)
+m3 <- findMRCIs(tree3)
+
+matList <- list(m1$mrciDepths,m2$mrciDepths,m3$mrciDepths) # create a list of the mrciDepths matrices
+matList
+wiwTreeDist(matList, sampled=1:6) # find the Euclidean distances between these matrices, where all six cases are sampled
+
+## ----tree123_sampled4:6--------------------------------------------------
+wiwTreeDist(matList, sampled=4:6)
+
+## ----trees1000-----------------------------------------------------------
+set.seed(123)
+num <- 500
+
+# create a list of 500 random transmission trees with 11 cases, where the source case is fixed as case 1:
+treelistSC1 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge # effectively creating a random transmission scenario
+ relabel <- sample(1:11) # create a relabelling so that infections don't all happen in numerical order, but we force the source case to be 1:
+ relabel[[which(relabel==1)]] <- relabel[[7]]
+ relabel[[7]] <- 1
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# create 500 more random transmission trees, but where the source case is fixed as case 2:
+treelistSC2 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge
+ relabel <- sample(1:11)
+ relabel[[which(relabel==2)]] <- relabel[[7]]
+ relabel[[7]] <- 2
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# combine:
+combinedLists <- c(treelistSC1,treelistSC2)
+
+# get mrciDepths matrices:
+matList1000 <- lapply(combinedLists, function(x)
+ findMRCIs(x)$mrciDepths
+)
+
+# find pairwise tree distances, treating all cases as sampled:
+WiwDists1000 <- wiwTreeDist(matList1000, sampled=1:11)
+
+## ----wiw_MDS1000, message=FALSE------------------------------------------
+wiwMDS <- dudi.pco(WiwDists1000, scannf=FALSE, nf=3)
+
+library(ggplot2)
+library(RColorBrewer)
+
+wiwPlot <- ggplot(wiwMDS$li, aes(x=wiwMDS$li[,1],y=wiwMDS$li[,2]))
+
+# prepare aesthetics
+depths <- sapply(matList1000, function(x) mean(x))
+sourcecase <- c(rep("1",num),rep("2",num))
+
+# prepare colours:
+colfunc <- colorRampPalette(brewer.pal(10,"Spectral"), space="Lab")
+
+wiwPlot +
+ geom_point(size=4, colour="gray60", aes(shape=sourcecase)) +
+ geom_point(size=3, aes(colour=depths, shape=sourcecase)) +
+ scale_colour_gradientn("Mean of v\n",
+ colours=colfunc(7),
+ guide = guide_colourbar(barheight=10)) +
+ scale_shape_discrete("Source case\n", solid=T, guide = guide_legend(keyheight = 3, keywidth=1.5)) +
+ theme_bw(base_size = 12, base_family = "") +
+ theme_bw(base_size = 12, base_family = "") +
+ theme(
+ legend.title = element_text(size=20),
+ legend.text = element_text(size=20),
+ axis.text.x = element_text(size=20), axis.text.y = element_text(size=20)) +
+ xlab("") + ylab("")
+
+## ----wiwMedian-----------------------------------------------------------
+med <- wiwMedTree(matList1000)
+
+## ----wiwMedian2----------------------------------------------------------
+names(med)
+
+## ----wiwMedTree----------------------------------------------------------
+med$median
+
+## ----wiwMedTreePlot------------------------------------------------------
+medgraph <- graph_from_edgelist(combinedLists[[med$median]])
+plot(medgraph)
+
diff --git a/inst/doc/TransmissionTreesVignette.Rmd b/inst/doc/TransmissionTreesVignette.Rmd
new file mode 100644
index 0000000..0458245
--- /dev/null
+++ b/inst/doc/TransmissionTreesVignette.Rmd
@@ -0,0 +1,214 @@
+---
+title: "treespace worked example: Transmission trees"
+author: "Michelle Kendall"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace worked example: Transmission trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+```
+
+
+This vignette demonstrates the use of *treespace* to compare a collection of transmission trees, as proposed in Kendall, Ayabina & Colijn, 2016 [arXiv:1609.09051](http://arxiv.org/abs/1609.09051).
+
+First we load the package *treespace*:
+
+```{r load, message=FALSE}
+library(treespace)
+```
+
+*treespace* contains three functions for handling and comparing transmission trees:
+
+1) `findMRCIs()` which takes a "who infected whom matrix" (the information about infectors and infectees; more on this below) and outputs:
+
++ `sourceCase`: the number of the node which is the source case, i.e. the common infector of all cases (outputs a warning if there is more than one source case).
+
++ `mrcis`: a matrix where, for each pair of individuals i and j, the entry (i,j) is the node number of their MRCI. Note that if i infected j then this entry is i itself.
+
++ `mrciDepths`: a matrix where, for each pair of individuals i and j, the entry (i,j) is the *depth* of their MRCI, defined as the number of edges from the source case. The source case has depth zero, its direct infectees have depth 1, and so on.
+
+2) `wiwTreeDist()` which takes a list of `mrciDepths` matrices and computes the distances between them. You have to supply the list of sampled cases in which you are interested, and then it takes the Euclidean distance between each pair of matrices restricted to the sampled cases (and written long-hand, as a vector)
+
+3) `wiwMedTree()` which takes a list of `mrciDepths` matrices, the list of sampled cases, an optional list of weights, and outputs the median transmission tree
+
+Examples
+---------
+
+We define a "who infected whom matrix" as a matrix of two columns, where the first represents the infectors and the second represents their infectees. For example, a simple transmission chain could be represented like this:
+```{r tree1}
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+tree1
+```
+
+This can be easily visualised as a transmission chain using graph plotting packages such as *igraph* or *visNetwork*:
+
+```{r igraph_tree1, message=FALSE}
+library(igraph)
+# set plotting options:
+igraph_options(vertex.size=15,
+ vertex.color="cyan",
+ vertex.label.cex=2,
+ edge.color="lightgrey",
+ edge.arrow.size=1)
+
+tree1graph <- graph_from_edgelist(tree1)
+plot(tree1graph)
+```
+
+Applying the function `findMRCIs` gives the following:
+```{r simple_wiwMRCIs}
+findMRCIs(tree1)
+```
+
+### Comparing three simple trees
+
+Suppose we had other hypotheses for the transmission tree which describes who infected whom amongst these six cases:
+```{r trees2_and_3}
+# a second scenario:
+tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+tree2
+tree2graph <- graph_from_edgelist(tree2)
+plot(tree2graph)
+
+# and a third scenario:
+tree3 <- cbind(Infector=c(2,2,2,2,6),Infectee=c(1,3,4,6,5))
+tree3
+tree3graph <- graph_from_edgelist(tree3)
+plot(tree3graph)
+```
+
+Then we can use *treespace* functions to make the following comparisons:
+```{r tree123_comparison}
+m1 <- findMRCIs(tree1) # find the source case, MRCIs and MRCI depths for tree 1
+m2 <- findMRCIs(tree2)
+m3 <- findMRCIs(tree3)
+
+matList <- list(m1$mrciDepths,m2$mrciDepths,m3$mrciDepths) # create a list of the mrciDepths matrices
+matList
+wiwTreeDist(matList, sampled=1:6) # find the Euclidean distances between these matrices, where all six cases are sampled
+```
+
+If we had only sampled cases 4, 5 and 6, so that "1", "2" and "3" could be regarded as arbitrary names of inferred, unsampled cases, we would compute:
+```{r tree123_sampled4:6}
+wiwTreeDist(matList, sampled=4:6)
+```
+which substantially changes the measures of similarities and differences between the trees.
+
+### Comparing many trees using an MDS plot
+
+Finally, we demonstrate comparing a larger set of transmission trees and finding the median:
+
+```{r trees1000}
+set.seed(123)
+num <- 500
+
+# create a list of 500 random transmission trees with 11 cases, where the source case is fixed as case 1:
+treelistSC1 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge # effectively creating a random transmission scenario
+ relabel <- sample(1:11) # create a relabelling so that infections don't all happen in numerical order, but we force the source case to be 1:
+ relabel[[which(relabel==1)]] <- relabel[[7]]
+ relabel[[7]] <- 1
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# create 500 more random transmission trees, but where the source case is fixed as case 2:
+treelistSC2 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge
+ relabel <- sample(1:11)
+ relabel[[which(relabel==2)]] <- relabel[[7]]
+ relabel[[7]] <- 2
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# combine:
+combinedLists <- c(treelistSC1,treelistSC2)
+
+# get mrciDepths matrices:
+matList1000 <- lapply(combinedLists, function(x)
+ findMRCIs(x)$mrciDepths
+)
+
+# find pairwise tree distances, treating all cases as sampled:
+WiwDists1000 <- wiwTreeDist(matList1000, sampled=1:11)
+```
+
+Now that we have a pairwise distance matrix we can use multidimensional scaling (MDS) to view the relative distances between the trees in a 2D projection. We will colour the points in the projection by the "depth" of the corresponding tree, and use symbols to indicate the source case. For "depth" here we simply use the mean of each "mrciDepths" matrix.
+
+```{r wiw_MDS1000, message=FALSE}
+wiwMDS <- dudi.pco(WiwDists1000, scannf=FALSE, nf=3)
+
+library(ggplot2)
+library(RColorBrewer)
+
+wiwPlot <- ggplot(wiwMDS$li, aes(x=wiwMDS$li[,1],y=wiwMDS$li[,2]))
+
+# prepare aesthetics
+depths <- sapply(matList1000, function(x) mean(x))
+sourcecase <- c(rep("1",num),rep("2",num))
+
+# prepare colours:
+colfunc <- colorRampPalette(brewer.pal(10,"Spectral"), space="Lab")
+
+wiwPlot +
+ geom_point(size=4, colour="gray60", aes(shape=sourcecase)) +
+ geom_point(size=3, aes(colour=depths, shape=sourcecase)) +
+ scale_colour_gradientn("Mean of v\n",
+ colours=colfunc(7),
+ guide = guide_colourbar(barheight=10)) +
+ scale_shape_discrete("Source case\n", solid=T, guide = guide_legend(keyheight = 3, keywidth=1.5)) +
+ theme_bw(base_size = 12, base_family = "") +
+ theme_bw(base_size = 12, base_family = "") +
+ theme(
+ legend.title = element_text(size=20),
+ legend.text = element_text(size=20),
+ axis.text.x = element_text(size=20), axis.text.y = element_text(size=20)) +
+ xlab("") + ylab("")
+```
+
+The symmetry in the plot corresponds to the different source cases, and the trees are also clearly separated by depth.
+
+### Median trees
+
+If our transmission trees corresponded to real data it could be meaningful to find a single representative tree. To find the geometric median tree(s) from a collection, we use the function `wiwMedTree`:
+
+```{r wiwMedian}
+med <- wiwMedTree(matList1000)
+```
+
+This returns a list with components:
+
+```{r wiwMedian2}
+names(med)
+```
+
+* `centre` is the mean vector (which may not necessarily correspond to a valid transmission tree with a single source case)
+
+* `distances` gives the distance of each tree from the centre, as a vector
+
+* `mindist` gives the minimum of these distances
+
+* `median` gives the number(s) of the median tree(s)
+
+Here the median tree is:
+
+```{r wiwMedTree}
+med$median
+```
+
+and looks like this:
+
+```{r wiwMedTreePlot}
+medgraph <- graph_from_edgelist(combinedLists[[med$median]])
+plot(medgraph)
+```
\ No newline at end of file
diff --git a/inst/doc/TransmissionTreesVignette.html b/inst/doc/TransmissionTreesVignette.html
new file mode 100644
index 0000000..5e6760d
--- /dev/null
+++ b/inst/doc/TransmissionTreesVignette.html
@@ -0,0 +1,313 @@
+<!DOCTYPE html>
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+
+<meta charset="utf-8">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="pandoc" />
+
+<meta name="viewport" content="width=device-width, initial-scale=1">
+
+<meta name="author" content="Michelle Kendall" />
+
+
+<title>treespace worked example: Transmission trees</title>
+
+
+
+<style type="text/css">code{white-space: pre;}</style>
+<style type="text/css">
+div.sourceCode { overflow-x: auto; }
+table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
+ margin: 0; padding: 0; vertical-align: baseline; border: none; }
+table.sourceCode { width: 100%; line-height: 100%; }
+td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
+td.sourceCode { padding-left: 5px; }
+code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
+code > span.dt { color: #902000; } /* DataType */
+code > span.dv { color: #40a070; } /* DecVal */
+code > span.bn { color: #40a070; } /* BaseN */
+code > span.fl { color: #40a070; } /* Float */
+code > span.ch { color: #4070a0; } /* Char */
+code > span.st { color: #4070a0; } /* String */
+code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
+code > span.ot { color: #007020; } /* Other */
+code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
+code > span.fu { color: #06287e; } /* Function */
+code > span.er { color: #ff0000; font-weight: bold; } /* Error */
+code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
+code > span.cn { color: #880000; } /* Constant */
+code > span.sc { color: #4070a0; } /* SpecialChar */
+code > span.vs { color: #4070a0; } /* VerbatimString */
+code > span.ss { color: #bb6688; } /* SpecialString */
+code > span.im { } /* Import */
+code > span.va { color: #19177c; } /* Variable */
+code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
+code > span.op { color: #666666; } /* Operator */
+code > span.bu { } /* BuiltIn */
+code > span.ex { } /* Extension */
+code > span.pp { color: #bc7a00; } /* Preprocessor */
+code > span.at { color: #7d9029; } /* Attribute */
+code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
+code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
+code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
+code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+</style>
+
+
+
+<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+
+</head>
+
+<body>
+
+
+
+
+<h1 class="title toc-ignore">treespace worked example: Transmission trees</h1>
+<h4 class="author"><em>Michelle Kendall</em></h4>
+
+
+
+<p>This vignette demonstrates the use of <em>treespace</em> to compare a collection of transmission trees, as proposed in Kendall, Ayabina & Colijn, 2016 <a href="http://arxiv.org/abs/1609.09051">arXiv:1609.09051</a>.</p>
+<p>First we load the package <em>treespace</em>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(treespace)</code></pre></div>
+<p><em>treespace</em> contains three functions for handling and comparing transmission trees:</p>
+<ol style="list-style-type: decimal">
+<li><code>findMRCIs()</code> which takes a “who infected whom matrix” (the information about infectors and infectees; more on this below) and outputs:</li>
+</ol>
+<ul>
+<li><p><code>sourceCase</code>: the number of the node which is the source case, i.e. the common infector of all cases (outputs a warning if there is more than one source case).</p></li>
+<li><p><code>mrcis</code>: a matrix where, for each pair of individuals i and j, the entry (i,j) is the node number of their MRCI. Note that if i infected j then this entry is i itself.</p></li>
+<li><p><code>mrciDepths</code>: a matrix where, for each pair of individuals i and j, the entry (i,j) is the <em>depth</em> of their MRCI, defined as the number of edges from the source case. The source case has depth zero, its direct infectees have depth 1, and so on.</p></li>
+</ul>
+<ol start="2" style="list-style-type: decimal">
+<li><p><code>wiwTreeDist()</code> which takes a list of <code>mrciDepths</code> matrices and computes the distances between them. You have to supply the list of sampled cases in which you are interested, and then it takes the Euclidean distance between each pair of matrices restricted to the sampled cases (and written long-hand, as a vector)</p></li>
+<li><p><code>wiwMedTree()</code> which takes a list of <code>mrciDepths</code> matrices, the list of sampled cases, an optional list of weights, and outputs the median transmission tree</p></li>
+</ol>
+<div id="examples" class="section level2">
+<h2>Examples</h2>
+<p>We define a “who infected whom matrix” as a matrix of two columns, where the first represents the infectors and the second represents their infectees. For example, a simple transmission chain could be represented like this:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">tree1 <-<span class="st"> </span><span class="kw">cbind</span>(<span class="dt">Infector=</span><span class="dv">1</span>:<span class="dv">5</span>,<span class="dt">Infectee=</span><span class="dv">2</span>:<span class="dv">6</span>)
+tree1</code></pre></div>
+<pre><code>## Infector Infectee
+## [1,] 1 2
+## [2,] 2 3
+## [3,] 3 4
+## [4,] 4 5
+## [5,] 5 6</code></pre>
+<p>This can be easily visualised as a transmission chain using graph plotting packages such as <em>igraph</em> or <em>visNetwork</em>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(igraph)
+<span class="co"># set plotting options:</span>
+<span class="kw">igraph_options</span>(<span class="dt">vertex.size=</span><span class="dv">15</span>,
+ <span class="dt">vertex.color=</span><span class="st">"cyan"</span>,
+ <span class="dt">vertex.label.cex=</span><span class="dv">2</span>,
+ <span class="dt">edge.color=</span><span class="st">"lightgrey"</span>,
+ <span class="dt">edge.arrow.size=</span><span class="dv">1</span>)
+
+tree1graph <-<span class="st"> </span><span class="kw">graph_from_edgelist</span>(tree1)
+<span class="kw">plot</span>(tree1graph)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nO3dd5xU9bn48We299532Z2lI0UEpUgRRFEQC7EgWNAoGk30l6Leq9crloSESPTGq5cYlYAGo4AiMYoFQbEgWGiKsODObO99dmdnp/3+WIK4zFZm5sx85/P+I69lTvHxZeDD98yZMzqn0ykAAEAtQVoPAAAA3I/AAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAA [...]
+<p>Applying the function <code>findMRCIs</code> gives the following:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">findMRCIs</span>(tree1)</code></pre></div>
+<pre><code>## $sourceCase
+## [1] 1
+##
+## $mrcis
+## [,1] [,2] [,3] [,4] [,5] [,6]
+## [1,] 1 1 1 1 1 1
+## [2,] 1 2 2 2 2 2
+## [3,] 1 2 3 3 3 3
+## [4,] 1 2 3 4 4 4
+## [5,] 1 2 3 4 5 5
+## [6,] 1 2 3 4 5 6
+##
+## $mrciDepths
+## [,1] [,2] [,3] [,4] [,5] [,6]
+## [1,] 0 0 0 0 0 0
+## [2,] 0 1 1 1 1 1
+## [3,] 0 1 2 2 2 2
+## [4,] 0 1 2 3 3 3
+## [5,] 0 1 2 3 4 4
+## [6,] 0 1 2 3 4 5</code></pre>
+<div id="comparing-three-simple-trees" class="section level3">
+<h3>Comparing three simple trees</h3>
+<p>Suppose we had other hypotheses for the transmission tree which describes who infected whom amongst these six cases:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># a second scenario:</span>
+tree2 <-<span class="st"> </span><span class="kw">cbind</span>(<span class="dt">Infector=</span><span class="kw">c</span>(<span class="dv">1</span>,<span class="dv">5</span>,<span class="dv">2</span>,<span class="dv">2</span>,<span class="dv">3</span>),<span class="dt">Infectee=</span><span class="dv">2</span>:<span class="dv">6</span>)
+tree2</code></pre></div>
+<pre><code>## Infector Infectee
+## [1,] 1 2
+## [2,] 5 3
+## [3,] 2 4
+## [4,] 2 5
+## [5,] 3 6</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">tree2graph <-<span class="st"> </span><span class="kw">graph_from_edgelist</span>(tree2)
+<span class="kw">plot</span>(tree2graph)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nO3dZ5hU9d3w8d/MbO+7bK/D0ouKoFIEFRAFzQ02RAWVx2jUGDUxxoiJCho1RGJuUUNQb8WCBYMCFpBeLCgoRdoC7s72Xbb3NuV5sUhZZsssM3tm/vP9vMi1zJlz+HldhC9nzpnz19lsNgEAAGrRaz0AAABwPgIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAKIjAAwCgIAIPAICCCDwAAAoi8AAAK [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># and a third scenario:</span>
+tree3 <-<span class="st"> </span><span class="kw">cbind</span>(<span class="dt">Infector=</span><span class="kw">c</span>(<span class="dv">2</span>,<span class="dv">2</span>,<span class="dv">2</span>,<span class="dv">2</span>,<span class="dv">6</span>),<span class="dt">Infectee=</span><span class="kw">c</span>(<span class="dv">1</span>,<span class="dv">3</span>,<span class="dv">4</span>,<span class="dv">6</span>,<span class="dv">5</span>))
+tree3</code></pre></div>
+<pre><code>## Infector Infectee
+## [1,] 2 1
+## [2,] 2 3
+## [3,] 2 4
+## [4,] 2 6
+## [5,] 6 5</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">tree3graph <-<span class="st"> </span><span class="kw">graph_from_edgelist</span>(tree3)
+<span class="kw">plot</span>(tree3graph)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nO3de3zT1f3H8U+a9JImaZtCaYGWFlrudwUR5CoOp8MLihO8bs4LwzmY013wp8I2p25O56ZzU+cNRGSItzmGF0CZKIh3bqWUcmlLW6BJm6SXXH9/hDGE9ErSb3Lyej72R8n3fL/9MMB3z/meiy4QCAgAAFBLgtYFAACA8CPgAQBQEAEPAICCCHgAABREwAMAoCACHgAABRHwAAAoiIAHAEBBBDwAAAoi4AEAUBABDwCAggh4AAAURMADAKAgAh4AAAUR8AAAKIiABwBAQQQ8AAAKIuABAFAQAQ8AgIIIeAAAFETAAwCgIAIeAAAFEfAAACiIgAcAQEEEPAAACiLgAQBQEAEPAICCCHgAABREwAMAoCACHgAAB [...]
+<p>Then we can use <em>treespace</em> functions to make the following comparisons:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">m1 <-<span class="st"> </span><span class="kw">findMRCIs</span>(tree1) <span class="co"># find the source case, MRCIs and MRCI depths for tree 1</span>
+m2 <-<span class="st"> </span><span class="kw">findMRCIs</span>(tree2)
+m3 <-<span class="st"> </span><span class="kw">findMRCIs</span>(tree3)
+
+matList <-<span class="st"> </span><span class="kw">list</span>(m1$mrciDepths,m2$mrciDepths,m3$mrciDepths) <span class="co"># create a list of the mrciDepths matrices</span>
+matList</code></pre></div>
+<pre><code>## [[1]]
+## [,1] [,2] [,3] [,4] [,5] [,6]
+## [1,] 0 0 0 0 0 0
+## [2,] 0 1 1 1 1 1
+## [3,] 0 1 2 2 2 2
+## [4,] 0 1 2 3 3 3
+## [5,] 0 1 2 3 4 4
+## [6,] 0 1 2 3 4 5
+##
+## [[2]]
+## [,1] [,2] [,3] [,4] [,5] [,6]
+## [1,] 0 0 0 0 0 0
+## [2,] 0 1 1 1 1 1
+## [3,] 0 1 3 1 2 3
+## [4,] 0 1 1 2 1 1
+## [5,] 0 1 2 1 2 2
+## [6,] 0 1 3 1 2 4
+##
+## [[3]]
+## [,1] [,2] [,3] [,4] [,5] [,6]
+## [1,] 1 0 0 0 0 0
+## [2,] 0 0 0 0 0 0
+## [3,] 0 0 1 0 0 0
+## [4,] 0 0 0 1 0 0
+## [5,] 0 0 0 0 2 1
+## [6,] 0 0 0 0 1 1</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">wiwTreeDist</span>(matList, <span class="dt">sampled=</span><span class="dv">1</span>:<span class="dv">6</span>) <span class="co"># find the Euclidean distances between these matrices, where all six cases are sampled</span></code></pre></div>
+<pre><code>## 1 2
+## 2 5.916
+## 3 10.630 7.616</code></pre>
+<p>If we had only sampled cases 4, 5 and 6, so that “1”, “2” and “3” could be regarded as arbitrary names of inferred, unsampled cases, we would compute:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">wiwTreeDist</span>(matList, <span class="dt">sampled=</span><span class="dv">4</span>:<span class="dv">6</span>)</code></pre></div>
+<pre><code>## 1 2
+## 2 5.477
+## 3 8.832 4.000</code></pre>
+<p>which substantially changes the measures of similarities and differences between the trees.</p>
+</div>
+<div id="comparing-many-trees-using-an-mds-plot" class="section level3">
+<h3>Comparing many trees using an MDS plot</h3>
+<p>Finally, we demonstrate comparing a larger set of transmission trees and finding the median:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">set.seed</span>(<span class="dv">123</span>)
+num <-<span class="st"> </span><span class="dv">500</span>
+
+<span class="co"># create a list of 500 random transmission trees with 11 cases, where the source case is fixed as case 1:</span>
+treelistSC1 <-<span class="st"> </span><span class="kw">lapply</span>(<span class="dv">1</span>:num, function(x) {
+ edges <-<span class="st"> </span><span class="kw">rtree</span>(<span class="dv">6</span>)$edge <span class="co"># effectively creating a random transmission scenario</span>
+ relabel <-<span class="st"> </span><span class="kw">sample</span>(<span class="dv">1</span>:<span class="dv">11</span>) <span class="co"># create a relabelling so that infections don't all happen in numerical order, but we force the source case to be 1:</span>
+ relabel[[<span class="kw">which</span>(relabel==<span class="dv">1</span>)]] <-<span class="st"> </span>relabel[[<span class="dv">7</span>]]
+ relabel[[<span class="dv">7</span>]] <-<span class="st"> </span><span class="dv">1</span>
+ relabelledEdges1 <-<span class="st"> </span><span class="kw">sapply</span>(edges[,<span class="dv">1</span>], function(x) relabel[[x]])
+ relabelledEdges2 <-<span class="st"> </span><span class="kw">sapply</span>(edges[,<span class="dv">2</span>], function(x) relabel[[x]])
+ <span class="kw">cbind</span>(relabelledEdges1,relabelledEdges2)
+})
+
+<span class="co"># create 500 more random transmission trees, but where the source case is fixed as case 2:</span>
+treelistSC2 <-<span class="st"> </span><span class="kw">lapply</span>(<span class="dv">1</span>:num, function(x) {
+ edges <-<span class="st"> </span><span class="kw">rtree</span>(<span class="dv">6</span>)$edge
+ relabel <-<span class="st"> </span><span class="kw">sample</span>(<span class="dv">1</span>:<span class="dv">11</span>)
+ relabel[[<span class="kw">which</span>(relabel==<span class="dv">2</span>)]] <-<span class="st"> </span>relabel[[<span class="dv">7</span>]]
+ relabel[[<span class="dv">7</span>]] <-<span class="st"> </span><span class="dv">2</span>
+ relabelledEdges1 <-<span class="st"> </span><span class="kw">sapply</span>(edges[,<span class="dv">1</span>], function(x) relabel[[x]])
+ relabelledEdges2 <-<span class="st"> </span><span class="kw">sapply</span>(edges[,<span class="dv">2</span>], function(x) relabel[[x]])
+ <span class="kw">cbind</span>(relabelledEdges1,relabelledEdges2)
+})
+
+<span class="co"># combine:</span>
+combinedLists <-<span class="st"> </span><span class="kw">c</span>(treelistSC1,treelistSC2)
+
+<span class="co"># get mrciDepths matrices:</span>
+matList1000 <-<span class="st"> </span><span class="kw">lapply</span>(combinedLists, function(x)
+ <span class="kw">findMRCIs</span>(x)$mrciDepths
+)
+
+<span class="co"># find pairwise tree distances, treating all cases as sampled:</span>
+WiwDists1000 <-<span class="st"> </span><span class="kw">wiwTreeDist</span>(matList1000, <span class="dt">sampled=</span><span class="dv">1</span>:<span class="dv">11</span>)</code></pre></div>
+<p>Now that we have a pairwise distance matrix we can use multidimensional scaling (MDS) to view the relative distances between the trees in a 2D projection. We will colour the points in the projection by the “depth” of the corresponding tree, and use symbols to indicate the source case. For “depth” here we simply use the mean of each “mrciDepths” matrix.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">wiwMDS <-<span class="st"> </span><span class="kw">dudi.pco</span>(WiwDists1000, <span class="dt">scannf=</span><span class="ot">FALSE</span>, <span class="dt">nf=</span><span class="dv">3</span>)
+
+<span class="kw">library</span>(ggplot2)
+<span class="kw">library</span>(RColorBrewer)
+
+wiwPlot <-<span class="st"> </span><span class="kw">ggplot</span>(wiwMDS$li, <span class="kw">aes</span>(<span class="dt">x=</span>wiwMDS$li[,<span class="dv">1</span>],<span class="dt">y=</span>wiwMDS$li[,<span class="dv">2</span>]))
+
+<span class="co"># prepare aesthetics</span>
+depths <-<span class="st"> </span><span class="kw">sapply</span>(matList1000, function(x) <span class="kw">mean</span>(x))
+sourcecase <-<span class="st"> </span><span class="kw">c</span>(<span class="kw">rep</span>(<span class="st">"1"</span>,num),<span class="kw">rep</span>(<span class="st">"2"</span>,num))
+
+<span class="co"># prepare colours:</span>
+colfunc <-<span class="st"> </span><span class="kw">colorRampPalette</span>(<span class="kw">brewer.pal</span>(<span class="dv">10</span>,<span class="st">"Spectral"</span>), <span class="dt">space=</span><span class="st">"Lab"</span>)
+
+wiwPlot +<span class="st"> </span>
+<span class="st"> </span><span class="kw">geom_point</span>(<span class="dt">size=</span><span class="dv">4</span>, <span class="dt">colour=</span><span class="st">"gray60"</span>, <span class="kw">aes</span>(<span class="dt">shape=</span>sourcecase)) +<span class="st"> </span>
+<span class="st"> </span><span class="kw">geom_point</span>(<span class="dt">size=</span><span class="dv">3</span>, <span class="kw">aes</span>(<span class="dt">colour=</span>depths, <span class="dt">shape=</span>sourcecase)) +
+<span class="st"> </span><span class="kw">scale_colour_gradientn</span>(<span class="st">"Mean of v</span><span class="ch">\n</span><span class="st">"</span>,
+ <span class="dt">colours=</span><span class="kw">colfunc</span>(<span class="dv">7</span>),
+ <span class="dt">guide =</span> <span class="kw">guide_colourbar</span>(<span class="dt">barheight=</span><span class="dv">10</span>)) +
+<span class="st"> </span><span class="kw">scale_shape_discrete</span>(<span class="st">"Source case</span><span class="ch">\n</span><span class="st">"</span>, <span class="dt">solid=</span>T, <span class="dt">guide =</span> <span class="kw">guide_legend</span>(<span class="dt">keyheight =</span> <span class="dv">3</span>, <span class="dt">keywidth=</span><span class="fl">1.5</span>)) +
+<span class="st"> </span><span class="kw">theme_bw</span>(<span class="dt">base_size =</span> <span class="dv">12</span>, <span class="dt">base_family =</span> <span class="st">""</span>) +
+<span class="st"> </span><span class="kw">theme_bw</span>(<span class="dt">base_size =</span> <span class="dv">12</span>, <span class="dt">base_family =</span> <span class="st">""</span>) +
+<span class="st"> </span><span class="kw">theme</span>(
+ <span class="dt">legend.title =</span> <span class="kw">element_text</span>(<span class="dt">size=</span><span class="dv">20</span>),
+ <span class="dt">legend.text =</span> <span class="kw">element_text</span>(<span class="dt">size=</span><span class="dv">20</span>),
+ <span class="dt">axis.text.x =</span> <span class="kw">element_text</span>(<span class="dt">size=</span><span class="dv">20</span>), <span class="dt">axis.text.y =</span> <span class="kw">element_text</span>(<span class="dt">size=</span><span class="dv">20</span>)) +
+<span class="st"> </span><span class="kw">xlab</span>(<span class="st">""</span>) +<span class="st"> </span><span class="kw">ylab</span>(<span class="st">""</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOydeXwURfr/a3KQIBAwBCEgAnKJKLCIIqewEFk0ogSQfLkRibqrqD+PXZb1C8Kq6KLigUpQAwY0IIRDwYMvggKyKOCyKkEMkuWWK1yBkGSmf3/UUjZ9TfU5fXzer3nxmvR0V9VMN/Wp56mnngoJgkAAAAAA4C/iYt0AAAAAAFgPBB4AAADwIRB4AAAAwIdA4AEAAAAfAoEHAAAAfAgEHgAAAPAhEHgAAADAhyTEugG6GTp0aLNmzZyvVxCESCQSHx/vfNUmqaioiIuLS0jw3r2urKxMTEyMdSt0Ew6Hw+FwtWrVYt0Q3YTD4VAoFBfnsXG/IAgVFRWJiYlebHk4HOb/v/nVV1+NGTMmJyfH1lYB3+C9Tr9Bg [...]
+<p>The symmetry in the plot corresponds to the different source cases, and the trees are also clearly separated by depth.</p>
+</div>
+<div id="median-trees" class="section level3">
+<h3>Median trees</h3>
+<p>If our transmission trees corresponded to real data it could be meaningful to find a single representative tree. To find the geometric median tree(s) from a collection, we use the function <code>wiwMedTree</code>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">med <-<span class="st"> </span><span class="kw">wiwMedTree</span>(matList1000)</code></pre></div>
+<p>This returns a list with components:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">names</span>(med)</code></pre></div>
+<pre><code>## [1] "centre" "distances" "mindist" "median"</code></pre>
+<ul>
+<li><p><code>centre</code> is the mean vector (which may not necessarily correspond to a valid transmission tree with a single source case)</p></li>
+<li><p><code>distances</code> gives the distance of each tree from the centre, as a vector</p></li>
+<li><p><code>mindist</code> gives the minimum of these distances</p></li>
+<li><p><code>median</code> gives the number(s) of the median tree(s)</p></li>
+</ul>
+<p>Here the median tree is:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">med$median</code></pre></div>
+<pre><code>## [1] 357</code></pre>
+<p>and looks like this:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">medgraph <-<span class="st"> </span><span class="kw">graph_from_edgelist</span>(combinedLists[[med$median]])
+<span class="kw">plot</span>(medgraph)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdd3xT5f4H8E9Gd5vOdLd0UTbIUMDLHg4QURAQEJSrFzfu68R9nVe9/pDrVREVuYoMRVFBkOllCQJFqd2ldKdJ0zZtk7RJzu+PQsWS7qTnJHzef9xXyPOcky/X0k/OOc+QCYIAIiIici9ysQsgIiIix2PAExERuSEGPBERkRtiwBMREbkhBjwREZEbYsATERG5IQY8ERGRG2LAExERuSEGPBERkRtiwBMREbkhBjwREZEbYsATERG5IQY8ERGRG2LAExERuSEGPBERkRtiwBMREbkhBjwREZEbYsATERG5IQY8ERGRG2LAExERuSEGPBERkRtiwBMREbkhBjwREZEbYsATERG5IQY8ERGRG2LAExERuSEGP [...]
+</div>
+</div>
+
+
+
+<!-- dynamically load mathjax for compatibility with self-contained -->
+<script>
+ (function () {
+ var script = document.createElement("script");
+ script.type = "text/javascript";
+ script.src = "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
+ document.getElementsByTagName("head")[0].appendChild(script);
+ })();
+</script>
+
+</body>
+</html>
diff --git a/inst/doc/introduction.R b/inst/doc/introduction.R
new file mode 100644
index 0000000..6af4ae9
--- /dev/null
+++ b/inst/doc/introduction.R
@@ -0,0 +1,153 @@
+## ----setup, echo=FALSE---------------------------------------------------
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+
+## ----install, eval=FALSE-------------------------------------------------
+# library(devtools)
+# install_github("thibautjombart/treespace")
+
+## ----install2, eval=FALSE------------------------------------------------
+# install.packages("treespace")
+
+## ----load----------------------------------------------------------------
+library("treespace")
+
+## ----load_packages, message=FALSE, warning=FALSE-------------------------
+library("treespace")
+library("adegenet")
+library("adegraphics")
+library("rgl")
+
+## ----treespace-----------------------------------------------------------
+# generate list of trees
+set.seed(1)
+x <- rmtree(10, 20)
+names(x) <- paste("tree", 1:10, sep = "")
+
+# use treespace
+res <- treespace(x, nf=3)
+names(res)
+res
+
+## ----distances-----------------------------------------------------------
+# table.image
+table.image(res$D, nclass=30)
+
+# table.value with some customization
+table.value(res$D, nclass=5, method="color",
+ symbol="circle", col=redpal(5))
+
+
+## ----plotgroves----------------------------------------------------------
+plotGroves(res$pco, lab.show=TRUE, lab.cex=1.5)
+
+## ----plotgrovesD3--------------------------------------------------------
+plotGrovesD3(res$pco, treeNames=1:10)
+
+## ----woodmicePlots-------------------------------------------------------
+data(woodmiceTrees)
+wm.res <- treespace(woodmiceTrees,nf=3)
+
+# PCs are stored in:
+head(wm.res$pco$li)
+
+# plot results
+plotGrovesD3(wm.res$pco)
+
+## ----findgroves, cache=FALSE---------------------------------------------
+wm.groves <- findGroves(wm.res, nclust=6)
+names(wm.groves)
+
+## ----plotgroves2---------------------------------------------------------
+# basic plot
+plotGrovesD3(wm.groves)
+
+# alternative with improved legend and tooltip text, giving the tree numbers:
+plotGrovesD3(wm.groves, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+
+# plot axes 2 and 3. This helps to show why, for example, clusters 2 and 4 have been identified as separate, despite them appearing to overlap when viewing axes 1 and 2.
+plotGrovesD3(wm.groves, xax=2, yax=3, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+
+## ----plotgroves_3D, rgl=TRUE, webgl=TRUE---------------------------------
+# prepare a colour palette:
+colours <- fac2col(wm.groves$groups, col.pal=funky)
+plot3d(wm.groves$treespace$pco$li[,1],
+ wm.groves$treespace$pco$li[,2],
+ wm.groves$treespace$pco$li[,3],
+ col=colours, type="s", size=1.5,
+ xlab="", ylab="", zlab="")
+
+## ----shiny_figures, echo=FALSE, out.width="650px", fig.retina = NULL-----
+knitr::include_graphics("figs/treespace3d.png")
+
+knitr::include_graphics("figs/treespaceTree.png")
+
+knitr::include_graphics("figs/treespaceDensiTree.png")
+
+## ----woodmiceMedian------------------------------------------------------
+# get first median tree
+tre <- medTree(woodmiceTrees)$trees[[1]]
+
+# plot tree
+plot(tre,type="cladogram",edge.width=3, cex=0.8)
+
+## ----woodmiceCluster1, out.width="600px"---------------------------------
+# find median trees for the 6 clusters identified earlier:
+res <- medTree(woodmiceTrees, wm.groves$groups)
+
+# there is one output per cluster
+names(res)
+
+# get the first median of each
+med.trees <- lapply(res, function(e) ladderize(e$trees[[1]]))
+
+# plot trees
+par(mfrow=c(2,3))
+for(i in 1:length(med.trees)) plot(med.trees[[i]], main=paste("cluster",i),cex=1.5)
+
+
+## ----woodmice_plotTreeDiff-----------------------------------------------
+# Compare median trees from clusters 1 and 2:
+plotTreeDiff(med.trees[[1]],med.trees[[2]], use.edge.length=FALSE)
+# Compare median trees from clusters 1 and 4, and change aesthetics:
+plotTreeDiff(med.trees[[1]],med.trees[[4]], type="cladogram", use.edge.length=FALSE, edge.width=2, colourMethod="palette",palette=spectral)
+
+## ----woodmice-tip-emphasis-----------------------------------------------
+wm3.res <- treespace(woodmiceTrees,nf=2,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+
+# plot results
+plotGrovesD3(wm3.res$pco)
+
+## ----findgroves-with-emphasis--------------------------------------------
+wm3.groves <- findGroves(woodmiceTrees,nf=3,nclust=6,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+plotGrovesD3(wm3.groves)
+
+## ----figure_construction, echo=FALSE, out.width="650px", fig.retina = NULL----
+knitr::include_graphics("figs/construction.png")
+
+## ----treevec-------------------------------------------------------------
+# generate a random tree:
+tree <- rtree(6)
+# topological vector of mrca distances from root:
+treeVec(tree)
+# vector of mrca distances from root when lambda=0.5:
+treeVec(tree,0.5)
+# vector of mrca distances as a function of lambda:
+vecAsFunction <- treeVec(tree,return.lambda.function=TRUE)
+# evaluate the vector at lambda=0.5:
+vecAsFunction(0.5)
+
+## ----treedist------------------------------------------------------------
+# generate random trees
+tree_a <- rtree(6)
+tree_b <- rtree(6)
+
+# topological (lambda=0) distance:
+treeDist(tree_a,tree_b)
+
+# branch-length focused (lambda=1) distance:
+treeDist(tree_a,tree_b,1)
+
diff --git a/inst/doc/introduction.Rmd b/inst/doc/introduction.Rmd
new file mode 100644
index 0000000..79dc296
--- /dev/null
+++ b/inst/doc/introduction.Rmd
@@ -0,0 +1,395 @@
+---
+title: "Exploration of landscapes of phylogenetic trees"
+author: "Thibaut Jombart, Michelle Kendall"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace: exploration of landscapes of phylogenetic trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+```
+
+*treespace* implements new methods for the exploration and analysis of distributions of phylogenetic trees for a given set of taxa.
+
+
+Installing *treespace*
+-------------
+To install the development version from github:
+```{r install, eval=FALSE}
+library(devtools)
+install_github("thibautjombart/treespace")
+```
+
+The stable version can be installed from CRAN using:
+```{r install2, eval=FALSE}
+install.packages("treespace")
+```
+
+Then, to load the package, use:
+```{r load}
+library("treespace")
+```
+
+
+Content overview
+-------------
+The main functions implemented in *treespace* are:
+
+* __`treespace`__: explore landscapes of phylogenetic trees
+
+* __`treespaceServer`__: open up an application in a web browser
+for an interactive exploration of the diversity in a set of trees
+
+* __`findGroves`__: identify clusters of similar trees
+
+* __`plotGroves`__: scatterplot of groups of trees, and __`plotGrovesD3`__ which enables interactive plotting based on d3.js
+
+* __`medTree`__: find geometric median tree(s) to summarise a group of trees
+
+Other functions are central to the computations of distances between trees:
+
+* __`treeVec`__: characterise a tree by a vector
+
+* __`treeDist`__: find the distance between two tree vectors
+
+* __`multiDist`__: find the pairwise distances of a list of trees
+
+* __`refTreeDist`__: find the distances of a list of trees from a reference tree
+
+* __`tipDiff`__: for a pair of trees, list the tips with differing ancestry
+
+* __`plotTreeDiff`__: plot a pair of trees, highlighting the tips with differing ancestry
+
+
+Distributed datasets include:
+
+* __`woodmiceTrees`__: illustrative set of 201 trees built using the neighbour-joining and bootstrapping example from the woodmice dataset in the ape documentation.
+
+* __`DengueTrees`__: 500 trees sampled from a BEAST posterior set of trees from (Drummond and Rambaut, 2007)
+
+* __`DengueSeqs`__: 17 dengue virus serotype 4 sequences from (Lanciotti *et al*., 1997), from which the `DengueTrees` were inferred.
+
+* __`DengueBEASTMCC`__: the maximum clade credibility (MCC) tree from the `DengueTrees`.
+
+
+
+Exploring trees with *treespace*
+--------------
+
+We first load *treespace*, and the packages required for graphics:
+```{r load_packages, message=FALSE, warning=FALSE}
+library("treespace")
+library("adegenet")
+library("adegraphics")
+library("rgl")
+```
+
+The function `treespace` defines typologies of phylogenetic trees using a two-step approach:
+
+1. perform pairwise comparisons of trees using various (Euclidean) metrics; by default, the comparison uses the Kendall and Colijn metric (Kendall and Colijn, 2016) which is described in more detail below; other metrics rely on tip distances implemented in *adephylo* (Jombart *et al.*, 2010) and *phangorn* (Schliep 2011).
+
+2. use Metric Multidimensional Scaling (MDS, aka Principal Coordinates Analysis, PCoA) to summarise pairwise distances between the trees as well as possible into a few dimensions; the output of the MDS is typically visualised using scatterplots of the first few Principal Components (PCs); this step relies on the PCoA implemented in *ade4* (Dray and Dufour, 2007).
+
+The function `treespace` performs both tasks, returning both the matrix of pairwise tree comparisons (`$D`), and the PCoA (`$pco`).
+This can be illustrated using randomly generated trees:
+```{r treespace}
+# generate list of trees
+set.seed(1)
+x <- rmtree(10, 20)
+names(x) <- paste("tree", 1:10, sep = "")
+
+# use treespace
+res <- treespace(x, nf=3)
+names(res)
+res
+```
+
+Pairwise tree distances can be visualised using *adegraphics*:
+```{r distances}
+# table.image
+table.image(res$D, nclass=30)
+
+# table.value with some customization
+table.value(res$D, nclass=5, method="color",
+ symbol="circle", col=redpal(5))
+
+```
+
+The best representation of these distances in a 2-dimensional space is given by the first 2 PCs of the MDS.
+These can be visualised using any scatter plotting tool; here we use the *treespace* function `plotGroves`, based on the *adegraphics* function `scatter`:
+
+```{r plotgroves}
+plotGroves(res$pco, lab.show=TRUE, lab.cex=1.5)
+```
+
+Alternatively, `plotGrovesD3` creates interactive plots based on d3.js:
+
+```{r plotgrovesD3}
+plotGrovesD3(res$pco, treeNames=1:10)
+```
+Tree labels can be dragged into new positions to avoid problems such as overlapping.
+
+The functionality of `treespace` can be further illustrated using *ape*'s dataset *woodmouse*, from which we built the 201 trees supplied in `woodmiceTrees` using the neighbour-joining and bootstrapping example from the *ape* documentation.
+```{r woodmicePlots}
+data(woodmiceTrees)
+wm.res <- treespace(woodmiceTrees,nf=3)
+
+# PCs are stored in:
+head(wm.res$pco$li)
+
+# plot results
+plotGrovesD3(wm.res$pco)
+```
+
+Packages such as *adegraphics* and *ggplot2* can be used to make alternative plots, for example visualising the density of points within the space.
+
+The *treespace* function `multiDist` simply performs the pairwise comparison of trees and outputs a distance matrix.
+This function may be preferable for large datasets, and when principal co-ordinate analysis is not required.
+It includes an option to save memory at the expense of computation time.
+
+
+
+
+Identifying clusters of trees
+--------------
+Once a typology of trees has been derived using the approach described above, one may want to formally identify clusters of similar trees.
+One simple approach is:
+
+1. select a few first PCs of the MDS (retaining signal but getting rid of random noise)
+
+2. derive pairwise Euclidean distances between trees based on these PCs
+
+3. use hierarchical clustering to obtain a dendrogram of these trees
+
+4. cut the dendrogram to obtain clusters
+
+In *treespace*, the function `findGroves` implements this approach, offering various clustering options (see `?findGroves`). Here we supply the function with our `treespace` output `wm.res` since we have already calculated it, but it is also possible to skip the steps above and directly supply `findGroves` with a multiPhylo list of trees.
+```{r findgroves, cache=FALSE}
+wm.groves <- findGroves(wm.res, nclust=6)
+names(wm.groves)
+```
+Note that when the number of clusters (`nclust`) is not provided, the function will display a dendrogram and ask for a cut-off height.
+
+The results can be plotted directly using `plotGrovesD3` (see `?plotGrovesD3` for options):
+```{r plotgroves2}
+# basic plot
+plotGrovesD3(wm.groves)
+
+# alternative with improved legend and tooltip text, giving the tree numbers:
+plotGrovesD3(wm.groves, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+
+# plot axes 2 and 3. This helps to show why, for example, clusters 2 and 4 have been identified as separate, despite them appearing to overlap when viewing axes 1 and 2.
+plotGrovesD3(wm.groves, xax=2, yax=3, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+```
+
+We can also plot in 3D:
+```{r plotgroves_3D, rgl=TRUE, webgl=TRUE}
+# prepare a colour palette:
+colours <- fac2col(wm.groves$groups, col.pal=funky)
+plot3d(wm.groves$treespace$pco$li[,1],
+ wm.groves$treespace$pco$li[,2],
+ wm.groves$treespace$pco$li[,3],
+ col=colours, type="s", size=1.5,
+ xlab="", ylab="", zlab="")
+```
+
+
+`treespaceServer`: a web application for *treespace*
+--------------
+The functionalities of `treespace` are also available via a user-friendly web interface, running locally on the default web browser.
+It can be started by simply typing `treespaceServer()`.
+The interface allows you to import trees and run `treespace` to view and explore the tree space in 2 or 3 dimensions.
+It is then straightforward to analyse the tree space by varying $\lambda$, looking for clusters using `findGroves` and saving results in various formats.
+Individual trees can be easily viewed, including median trees per cluster (see below). Pairs of trees can be viewed together with their tip-differences highlighted using the function `plotTreeDiff`, and collections of trees can be seen together using `densiTree` from the package *phangorn*.
+It is fully documented in the *help* tab.
+
+
+```{r shiny_figures, echo=FALSE, out.width="650px", fig.retina = NULL}
+knitr::include_graphics("figs/treespace3d.png")
+
+knitr::include_graphics("figs/treespaceTree.png")
+
+knitr::include_graphics("figs/treespaceDensiTree.png")
+```
+
+
+
+
+
+Finding median trees
+--------------
+
+When a set of trees have very similar structures, it makes sense to summarize them into a single 'consensus' tree.
+In `treespace`, this is achieved by finding the *median tree* for a set of trees according to the Kendall and Colijn metric.
+That is, we find the tree which is closest to the centre of the set of trees in the tree landscape defined in `treespace`.
+This procedure is implemented by the function `medTree`:
+
+```{r woodmiceMedian}
+# get first median tree
+tre <- medTree(woodmiceTrees)$trees[[1]]
+
+# plot tree
+plot(tre,type="cladogram",edge.width=3, cex=0.8)
+```
+
+However, a more complete and accurate summary of the data can be given by finding a summary tree from each cluster.
+This is achieved using the `groups` argument of `medTree`:
+```{r woodmiceCluster1, out.width="600px"}
+# find median trees for the 6 clusters identified earlier:
+res <- medTree(woodmiceTrees, wm.groves$groups)
+
+# there is one output per cluster
+names(res)
+
+# get the first median of each
+med.trees <- lapply(res, function(e) ladderize(e$trees[[1]]))
+
+# plot trees
+par(mfrow=c(2,3))
+for(i in 1:length(med.trees)) plot(med.trees[[i]], main=paste("cluster",i),cex=1.5)
+
+```
+
+These trees exhibit a number of topological differences, e.g. in the placement of the **(1007S,1208S,0909S)** clade.
+To examine the differences between the trees in a pairwise manner, we can use the function `plotTreeDiff`, for example:
+
+```{r woodmice_plotTreeDiff}
+# Compare median trees from clusters 1 and 2:
+plotTreeDiff(med.trees[[1]],med.trees[[2]], use.edge.length=FALSE)
+# Compare median trees from clusters 1 and 4, and change aesthetics:
+plotTreeDiff(med.trees[[1]],med.trees[[4]], type="cladogram", use.edge.length=FALSE, edge.width=2, colourMethod="palette",palette=spectral)
+```
+
+Performing this analysis enables the detection of distinct representative trees supported by data.
+
+Note that in this example we supplied the function `medTree` with the multiPhylo list of trees. A more computationally efficient process (at the expense of using more memory) is to use the option `return.tree.vectors` in the initial `treespace` call, and then supply these vectors directly to `medTree`.
+In this case, the tree indices are returned by `medTree` but the trees are not (since they were not supplied).
+
+Emphasising the placement of certain tips or clades
+--------------
+
+In some analyses it may be informative to emphasise the placement of particular tips or clades within a set of trees. This can be particularly useful in large trees where the study is focused on a smaller clade. Priority can be given to a list of tips using the argument `emphasise.tips`, whose corresponding values in the vector comparison will be given a weight of `emphasise.weight` times the others (the default is 2, i.e. twice the weight).
+
+For example, if we wanted to emphasise where the woodmice trees agree and disagree on the placement of the **(1007S,1208S,0909S)** clade, we can simply emphasise that clade as follows:
+```{r woodmice-tip-emphasis}
+wm3.res <- treespace(woodmiceTrees,nf=2,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+
+# plot results
+plotGrovesD3(wm3.res$pco)
+```
+
+It can be seen from the scale of the plot and the density of clustering that the trees are now separated into more distinct clusters.
+```{r findgroves-with-emphasis}
+wm3.groves <- findGroves(woodmiceTrees,nf=3,nclust=6,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+plotGrovesD3(wm3.groves)
+```
+
+Conversely, where the structure of a particular clade is not of interest (for example, lineages within an outgroup which was only included for rooting purposes), those tips can be given a weight less than 1 so as to give them less emphasis in the comparison. We note that although it is possible to give tips a weighting of 0, we advise caution with this as the underlying function will no longer be guaranteed to be a metric. That is, a distance of 0 between two trees will no longer necessa [...]
+
+Method: characterising a tree by a vector
+--------------
+Kendall and Colijn proposed a [metric](http://dx.doi.org/10.1093/molbev/msw124) for comparing rooted phylogenetic trees (Kendall and COlijn, 2016). Each tree is characterised by a vector which notes the placement of the most recent common ancestor (MRCA) of each pair of tips, as demonstrated in this example:
+
+```{r figure_construction, echo=FALSE, out.width="650px", fig.retina = NULL}
+knitr::include_graphics("figs/construction.png")
+```
+
+Specifically, it records the distance between the MRCA of a pair of tips $(i,j)$ and the root in two ways: the number of edges $m_{i,j}$, and the path length $M_{i,j}$. It also records the length $p_i$ of each 'pendant' edge between a tip $i$ and its immediate ancestor. This procedure results in two vectors for a tree $T$:
+
+$$
+m(T) = (m_{1,2}, m_{1,3},...,m_{k-1,k},1,...,1)
+$$
+
+and
+
+$$
+M(T) = (M_{1,2}, M_{1,3},...,M_{k-1,k},p_1,...,p_k).
+$$
+
+In $m(T)$ we record the pendant lengths as 1, as each tip is 1 step from its immediate ancestor. We combine $m$ and $M$ with a parameter $\lambda$ between zero and one to weight the contribution of branch lengths, characterising each tree with a vector
+
+$$
+v_\lambda(T) = (1-\lambda)m(T) + \lambda M(T).
+$$
+
+This is implemented as the function __`treeVec`__. For example,
+```{r treevec}
+# generate a random tree:
+tree <- rtree(6)
+# topological vector of mrca distances from root:
+treeVec(tree)
+# vector of mrca distances from root when lambda=0.5:
+treeVec(tree,0.5)
+# vector of mrca distances as a function of lambda:
+vecAsFunction <- treeVec(tree,return.lambda.function=TRUE)
+# evaluate the vector at lambda=0.5:
+vecAsFunction(0.5)
+```
+
+The metric -- the distance between two trees -- is the Euclidean distance between these vectors:
+
+$$
+d_\lambda(T_a, T_b) = || v_\lambda(T_a) - v_\lambda(T_b) ||.
+$$
+
+This can be found using __`treeDist`__:
+```{r treedist}
+# generate random trees
+tree_a <- rtree(6)
+tree_b <- rtree(6)
+
+# topological (lambda=0) distance:
+treeDist(tree_a,tree_b)
+
+# branch-length focused (lambda=1) distance:
+treeDist(tree_a,tree_b,1)
+```
+
+
+
+References
+--------------
+
+* Dray, S. and Dufour, A. B. (2007) The ade4 package: implementing the duality diagram for ecologists. Journal of Statistical Software 22(4): 1-20.
+
+* Drummond, A. J. and Rambaut, A. (2007)
+BEAST: Bayesian evolutionary analysis by sampling trees.
+BMC Evolutionary Biology, 7(1), 214.
+
+* Jombart, T., Balloux, F. and Dray, S. (2010) adephylo: new tools for investigating the phylogenetic signal in biological traits. Bioinformatics 26: 1907-1909. DOI: 10.1093/bioinformatics/btq292
+
+* Kendall, M. and Colijn, C. (2016) Mapping phylogenetic trees to reveal distinct patterns of evolution. Molecular Biology and Evolution, first published online: June 24, 2016. DOI: 10.1093/molbev/msw124
+
+* Lanciotti, R. S., Gubler, D. J. and Trent, D. W. (1997)
+Molecular evolution and phylogeny of dengue-4 viruses.
+Journal of General Virology, 78(9), 2279-2286.
+
+* Schliep, K. P. (2011) phangorn: phylogenetic analysis in R. Bioinformatics 27(4): 592-593.
+
+
+Authors / Contributors
+--------------
+Authors:
+
+* [Thibaut Jombart](https://sites.google.com/site/thibautjombart/)
+
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
+
+Contributors:
+
+* [Jacob Almagro-Garcia](http://www.well.ox.ac.uk/jacob-almagro-garcia)
+
+* [Caroline Colijn](http://www.imperial.ac.uk/people/c.colijn)
+
+Maintainer of the CRAN version:
+
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
diff --git a/inst/doc/introduction.html b/inst/doc/introduction.html
new file mode 100644
index 0000000..2e6664b
--- /dev/null
+++ b/inst/doc/introduction.html
@@ -0,0 +1,437 @@
+<!DOCTYPE html>
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+
+<meta charset="utf-8">
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<meta name="generator" content="pandoc" />
+
+<meta name="viewport" content="width=device-width, initial-scale=1">
+
+<meta name="author" content="Thibaut Jombart, Michelle Kendall" />
+
+<meta name="date" content="2017-03-16" />
+
+<title>Exploration of landscapes of phylogenetic trees</title>
+
+<script src="data:application/x-javascript;base64,KGZ1bmN0aW9uKCkgewogIC8vIElmIHdpbmRvdy5IVE1MV2lkZ2V0cyBpcyBhbHJlYWR5IGRlZmluZWQsIHRoZW4gdXNlIGl0OyBvdGhlcndpc2UgY3JlYXRlIGEKICAvLyBuZXcgb2JqZWN0LiBUaGlzIGFsbG93cyBwcmVjZWRpbmcgY29kZSB0byBzZXQgb3B0aW9ucyB0aGF0IGFmZmVjdCB0aGUKICAvLyBpbml0aWFsaXphdGlvbiBwcm9jZXNzICh0aG91Z2ggbm9uZSBjdXJyZW50bHkgZXhpc3QpLgogIHdpbmRvdy5IVE1MV2lkZ2V0cyA9IHdpbmRvdy5IVE1MV2lkZ2V0cyB8fCB7fTsKCiAgLy8gU2VlIGlmIHdlJ3JlIHJ1bm5pbmcgaW4gYSB2aWV3ZXIgcGFuZS4gSWYgbm90LCB3ZS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1jb2xvci8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxlKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2UoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sZSk6ZSh0LmQzPXQuZDN8fHt9KX0odGhpcyxmdW5jdGlvbih0KXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gZSh0LGUsbil7dC5wcm90b3R5cGU9ZS5wcm90b3R5cGU9bixuLmNvbnN0cnVjdG9yPXR9ZnVuY3Rpb24gbi [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1hcnJheS8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24obixyKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP3IoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0scik6cihuLmQzPW4uZDN8fHt9KX0odGhpcyxmdW5jdGlvbihuKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gcihuLHIpe3JldHVybiBuPHI/LTE6bj5yPzE6bj49cj8wOk5hTn1mdW5jdGlvbiB0KG4pe3JldHVybiAxPT [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1jb2xsZWN0aW9uLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihuLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSx0KTp0KG4uZDM9bi5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiB0KCl7fWZ1bmN0aW9uIGUobixlKXt2YXIgcj1uZXcgdDtpZihuIGluc3RhbmNlb2YgdCluLmVhY2 [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1mb3JtYXQvIFZlcnNpb24gMS4wLjIuIENvcHlyaWdodCAyMDE2IE1pa2UgQm9zdG9jay4KIWZ1bmN0aW9uKHQsbil7Im9iamVjdCI9PXR5cGVvZiBleHBvcnRzJiYidW5kZWZpbmVkIiE9dHlwZW9mIG1vZHVsZT9uKGV4cG9ydHMpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyJdLG4pOm4odC5kMz10LmQzfHx7fSl9KHRoaXMsZnVuY3Rpb24odCl7InVzZSBzdHJpY3QiO2Z1bmN0aW9uIG4odCxuKXtpZigocj0odD1uP3QudG9FeHBvbmVudGlhbChuLTEpOnQudG9FeHBvbmVudGlhbCgpKS5pbm [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1kaXNwYXRjaC8gVmVyc2lvbiAxLjAuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24obixlKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2UoZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sZSk6ZShuLmQzPW4uZDN8fHt9KX0odGhpcyxmdW5jdGlvbihuKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gZSgpe2Zvcih2YXIgbixlPTAscj1hcmd1bWVudHMubGVuZ3RoLG89e307ZTxyOysrZSl7aWYoIShuPW [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1lYXNlLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihuLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSx0KTp0KG4uZDM9bi5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiB0KG4pe3JldHVybitufWZ1bmN0aW9uIGUobil7cmV0dXJuIG4qbn1mdW5jdGlvbiB1KG4pe3JldHVybiBuKi [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1pbnRlcnBvbGF0ZS8gVmVyc2lvbiAxLjEuMS4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyxyZXF1aXJlKCJkMy1jb2xvciIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiLCJkMy1jb2xvciJdLG4pOm4odC5kMz10LmQzfHx7fSx0LmQzKX0odGhpcyxmdW5jdGlvbih0LG4peyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiByKHQsbixyLGUsbyl7dmFyIG [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zZWxlY3Rpb24vIFZlcnNpb24gMS4wLjIuIENvcHlyaWdodCAyMDE2IE1pa2UgQm9zdG9jay4KIWZ1bmN0aW9uKHQsbil7Im9iamVjdCI9PXR5cGVvZiBleHBvcnRzJiYidW5kZWZpbmVkIiE9dHlwZW9mIG1vZHVsZT9uKGV4cG9ydHMpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyJdLG4pOm4odC5kMz10LmQzfHx7fSl9KHRoaXMsZnVuY3Rpb24odCl7InVzZSBzdHJpY3QiO2Z1bmN0aW9uIG4odCl7dmFyIG49dCs9IiIsZT1uLmluZGV4T2YoIjoiKTtyZXR1cm4gZT49MCYmInhtbG5zIiE9PS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zY2FsZS8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24oZSxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyxyZXF1aXJlKCJkMy1hcnJheSIpLHJlcXVpcmUoImQzLWNvbGxlY3Rpb24iKSxyZXF1aXJlKCJkMy1pbnRlcnBvbGF0ZSIpLHJlcXVpcmUoImQzLWZvcm1hdCIpLHJlcXVpcmUoImQzLXRpbWUiKSxyZXF1aXJlKCJkMy10aW1lLWZvcm1hdCIpLHJlcXVpcmUoImQzLWNvbG9yIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZW [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy10aW1lci8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxuKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP24oZXhwb3J0cyk6ImZ1bmN0aW9uIj09dHlwZW9mIGRlZmluZSYmZGVmaW5lLmFtZD9kZWZpbmUoWyJleHBvcnRzIl0sbik6bih0LmQzPXQuZDN8fHt9KX0odGhpcyxmdW5jdGlvbih0KXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gbigpe3JldHVybiB4fHwoVChlKSx4PWIubm93KCkrdyl9ZnVuY3Rpb24gZSgpe3g9MH1mdW5jdGlvbiBpKC [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy10cmFuc2l0aW9uLyBWZXJzaW9uIDEuMC4yLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LG4peyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/bihleHBvcnRzLHJlcXVpcmUoImQzLXNlbGVjdGlvbiIpLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtdGltZXIiKSxyZXF1aXJlKCJkMy1pbnRlcnBvbGF0ZSIpLHJlcXVpcmUoImQzLWNvbG9yIikscmVxdWlyZSgiZDMtZWFzZSIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZm [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1kcmFnLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbihlLHQpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/dChleHBvcnRzLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtc2VsZWN0aW9uIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyIsImQzLWRpc3BhdGNoIiwiZDMtc2VsZWN0aW9uIl0sdCk6dChlLmQzPWUuZDN8fHt9LGUuZDMsZS5kMyl9KHRoaXMsZnVuY3Rpb24oZS [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1wYXRoLyBWZXJzaW9uIDEuMC4xLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LHMpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/cyhleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSxzKTpzKHQuZDM9dC5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKHQpeyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiBzKCl7dGhpcy5feDA9dGhpcy5feTA9dGhpcy5feDE9dGhpcy5feTE9bnVsbCx0aGlzLl89W119ZnVuY3Rpb2 [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1zaGFwZS8gVmVyc2lvbiAxLjAuMy4gQ29weXJpZ2h0IDIwMTYgTWlrZSBCb3N0b2NrLgohZnVuY3Rpb24odCxpKXsib2JqZWN0Ij09dHlwZW9mIGV4cG9ydHMmJiJ1bmRlZmluZWQiIT10eXBlb2YgbW9kdWxlP2koZXhwb3J0cyxyZXF1aXJlKCJkMy1wYXRoIikpOiJmdW5jdGlvbiI9PXR5cGVvZiBkZWZpbmUmJmRlZmluZS5hbWQ/ZGVmaW5lKFsiZXhwb3J0cyIsImQzLXBhdGgiXSxpKTppKHQuZDM9dC5kM3x8e30sdC5kMyl9KHRoaXMsZnVuY3Rpb24odCxpKXsidXNlIHN0cmljdCI7ZnVuY3Rpb24gbih0KXtyZXR1cm4gZnVuY3Rpb24oKXtyZX [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy1heGlzLyBWZXJzaW9uIDEuMC4zLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LG4peyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/bihleHBvcnRzKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiXSxuKTpuKHQuZDM9dC5kM3x8e30pfSh0aGlzLGZ1bmN0aW9uKHQpeyJ1c2Ugc3RyaWN0IjtmdW5jdGlvbiBuKHQpe3JldHVybiB0fWZ1bmN0aW9uIGUodCxuLGUpe3ZhciByPXQoZSk7cmV0dXJuInRyYW5zbGF0ZSgiKy [...]
+<script src="data:application/x-javascript;base64,IWZ1bmN0aW9uIGEoYixjLGQpe2Z1bmN0aW9uIGUoZyxoKXtpZighY1tnXSl7aWYoIWJbZ10pe3ZhciBpPSJmdW5jdGlvbiI9PXR5cGVvZiByZXF1aXJlJiZyZXF1aXJlO2lmKCFoJiZpKXJldHVybiBpKGcsITApO2lmKGYpcmV0dXJuIGYoZywhMCk7dmFyIGo9bmV3IEVycm9yKCJDYW5ub3QgZmluZCBtb2R1bGUgJyIrZysiJyIpO3Rocm93IGouY29kZT0iTU9EVUxFX05PVF9GT1VORCIsan12YXIgaz1jW2ddPXtleHBvcnRzOnt9fTtiW2ddWzBdLmNhbGwoay5leHBvcnRzLGZ1bmN0aW9uKGEpe3ZhciBjPWJbZ11bMV1bYV07cmV0dXJuIGUoYz9jOmEpfSxrLGsuZXhwb3J0cyxhLGIsYy [...]
+<script src="data:application/x-javascript;base64,Ly8gaHR0cHM6Ly9kM2pzLm9yZy9kMy16b29tLyBWZXJzaW9uIDEuMC4zLiBDb3B5cmlnaHQgMjAxNiBNaWtlIEJvc3RvY2suCiFmdW5jdGlvbih0LGUpeyJvYmplY3QiPT10eXBlb2YgZXhwb3J0cyYmInVuZGVmaW5lZCIhPXR5cGVvZiBtb2R1bGU/ZShleHBvcnRzLHJlcXVpcmUoImQzLWRpc3BhdGNoIikscmVxdWlyZSgiZDMtZHJhZyIpLHJlcXVpcmUoImQzLWludGVycG9sYXRlIikscmVxdWlyZSgiZDMtc2VsZWN0aW9uIikscmVxdWlyZSgiZDMtdHJhbnNpdGlvbiIpKToiZnVuY3Rpb24iPT10eXBlb2YgZGVmaW5lJiZkZWZpbmUuYW1kP2RlZmluZShbImV4cG9ydHMiLCJkMy1kaX [...]
+<link href="data:text/css;charset=utf-8,%2Elasso%20path%20%7B%0Astroke%3A%20rgb%2880%2C80%2C80%29%3B%0Astroke%2Dwidth%3A%202px%3B%0A%7D%0A%2Elasso%20%2Edrawn%20%7B%0Afill%3A%20%23CCCCCC%3B%0Afill%2Dopacity%3A%20%2E15%20%3B%0A%7D%0A%2Elasso%20%2Eloop%5Fclose%20%7B%0Afill%3A%20none%3B%0Astroke%2Ddasharray%3A%204%2C4%3B%0A%7D%0A%2Elasso%20%2Eorigin%20%7B%0Afill%3A%20%233399FF%3B%0Afill%2Dopacity%3A%20%2E5%3B%0A%7D%0A%2EscatterD3%20%2Enot%2Dpossible%2Dlasso%20%7B%0Afill%3A%20rgb%28150%2C150% [...]
+<script src="data:application/x-javascript;base64,ZDMubGFzc28gPSBmdW5jdGlvbigpIHsKCiAgICB2YXIgaXRlbXMgPSBudWxsLAogICAgICAgIGNsb3NlUGF0aERpc3RhbmNlID0gNzUsCiAgICAgICAgY2xvc2VQYXRoU2VsZWN0ID0gdHJ1ZSwKICAgICAgICBpc1BhdGhDbG9zZWQgPSBmYWxzZSwKICAgICAgICBob3ZlclNlbGVjdCA9IHRydWUsCiAgICAgICAgcG9pbnRzID0gW10sCiAgICAgICAgYXJlYSA9IG51bGwsCiAgICAgICAgb24gPSB7c3RhcnQ6ZnVuY3Rpb24oKXt9LCBkcmF3OiBmdW5jdGlvbigpe30sIGVuZDogZnVuY3Rpb24oKXt9fTsKCiAgICBmdW5jdGlvbiBsYXNzbyhzZWxlY3Rpb24pIHsKCiAgICAgICAgLy8gdG [...]
+<link href="data:text/css;charset=utf-8,%0A%2EscatterD3%2Dtooltip%20%7B%0Aposition%3A%20absolute%3B%0Acolor%3A%20%23222%3B%0Abackground%3A%20%23fff%3B%0Apadding%3A%20%2E5em%3B%0Atext%2Dshadow%3A%20%23f5f5f5%200%201px%200%3B%0Aborder%2Dradius%3A%202px%3B%0Abox%2Dshadow%3A%200px%200px%207px%201px%20%23a6a6a6%3B%0Aopacity%3A%200%2E95%3B%0Afont%2Dfamily%3A%20Open%20Sans%2C%20Droid%20Sans%2C%20Helvetica%2C%20Verdana%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2010px%3B%0Az%2Dindex%3A%2010%3B%0A%7D% [...]
+<script src="data:application/x-javascript;base64,Ly8gQ2xlYW4gdmFyaWFibGVzIGxldmVscyB0byBiZSB2YWxpZCBDU1MgY2xhc3NlcwpmdW5jdGlvbiBjc3NfY2xlYW4ocykgewogICAgaWYgKHMgPT09IHVuZGVmaW5lZCkgcmV0dXJuICIiOwogICAgcmV0dXJuIHMudG9TdHJpbmcoKS5yZXBsYWNlKC9bXlx3LV0vZywgIl8iKTsKfQoKLy8gRGVmYXVsdCB0cmFuc2xhdGlvbiBmdW5jdGlvbiBmb3IgcG9pbnRzIGFuZCBsYWJlbHMKZnVuY3Rpb24gdHJhbnNsYXRpb24oZCwgc2NhbGVzKSB7CiAgICAgcmV0dXJuICJ0cmFuc2xhdGUoIiArIHNjYWxlcy54KGQueCkgKyAiLCIgKyBzY2FsZXMueShkLnkpICsgIikiOwp9CgovLyBDcmVhdG [...]
+<script src="data:application/x-javascript;base64,Ly8gQ3VzdG9tIGNvbG9yIHNjaGVtZQpmdW5jdGlvbiBjdXN0b21fc2NoZW1lMTAgKCkgewogICAgLy8gc2xpY2UoKSB0byBjcmVhdGUgYSBjb3B5CiAgICB2YXIgc2NoZW1lID0gZDMuc2NoZW1lQ2F0ZWdvcnkxMC5zbGljZSgpOwogICAgLy8gU3dpdGNoIG9yYW5nZSBhbmQgcmVkCiAgICB2YXIJdG1wID0gc2NoZW1lWzNdOwogICAgc2NoZW1lWzNdID0gc2NoZW1lWzFdOwogICAgc2NoZW1lWzFdID0gdG1wOwogICAgcmV0dXJuIHNjaGVtZTsKfQoKLy8gU2V0dXAgZGltZW5zaW9ucwpmdW5jdGlvbiBzZXR1cF9zaXplcyAod2lkdGgsIGhlaWdodCwgc2V0dGluZ3MpIHsKCiAgICB2YX [...]
+<script src="data:application/x-javascript;base64,Ly8gQ3JlYXRlIGFuZCBkcmF3IHggYW5kIHkgYXhlcwpmdW5jdGlvbiBhZGRfYXhlcyhzZWxlY3Rpb24sIGRpbXMsIHNldHRpbmdzLCBzY2FsZXMpIHsKCiAgICAvLyB4IGF4aXMKICAgIHNlbGVjdGlvbi5hcHBlbmQoImciKQogICAgICAgIC5hdHRyKCJjbGFzcyIsICJ4IGF4aXMiKQogICAgICAgIC5hdHRyKCJ0cmFuc2Zvcm0iLCAidHJhbnNsYXRlKDAsIiArIGRpbXMuaGVpZ2h0ICsgIikiKQogICAgICAgIC5zdHlsZSgiZm9udC1zaXplIiwgc2V0dGluZ3MuYXhlc19mb250X3NpemUpCiAgICAgICAgLmNhbGwoc2NhbGVzLnhBeGlzKTsKCiAgICAvLyB5IGF4aXMKICAgIHNlbGVjdG [...]
+<script src="data:application/x-javascript;base64,Ly8gUmV0dXJucyBkb3Qgc2l6ZSBmcm9tIGFzc29jaWF0ZWQgZGF0YQpmdW5jdGlvbiBkb3Rfc2l6ZShkYXRhLCBzZXR0aW5ncywgc2NhbGVzKSB7CiAgICB2YXIgc2l6ZSA9IHNldHRpbmdzLnBvaW50X3NpemU7CiAgICBpZiAoc2V0dGluZ3MuaGFzX3NpemVfdmFyKSB7IHNpemUgPSBzY2FsZXMuc2l6ZShkYXRhLnNpemVfdmFyKTsgfQogICAgcmV0dXJuKHNpemUpOwp9CgovLyBJbml0aWFsIGRvdCBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGRvdF9pbml0IChzZWxlY3Rpb24sIHNldHRpbmdzLCBzY2FsZXMpIHsKICAgIC8vIHRvb2x0aXBzIHdoZW4gaG92ZXJpbmcgcG9pbnRzCiAgICB2YX [...]
+<script src="data:application/x-javascript;base64,CmZ1bmN0aW9uIGFkZF9hcnJvd3NfZGVmcyhzdmcsIHNldHRpbmdzLCBzY2FsZXMpIHsKICAgIC8vIDxkZWZzPgogICAgdmFyIGRlZnMgPSBzdmcuYXBwZW5kKCJkZWZzIik7CiAgICAvLyBhcnJvdyBoZWFkIG1hcmtlcnMKICAgIHNjYWxlcy5jb2xvci5yYW5nZSgpLmZvckVhY2goZnVuY3Rpb24oZCkgewogICAgICAgIGRlZnMuYXBwZW5kKCJtYXJrZXIiKQoJICAgIC5hdHRyKCJpZCIsICJhcnJvdy1oZWFkLSIgKyBzZXR0aW5ncy5odG1sX2lkICsgIi0iICsgZCkKCSAgICAuYXR0cigibWFya2VyV2lkdGgiLCAiMTAiKQoJICAgIC5hdHRyKCJtYXJrZXJIZWlnaHQiLCAiMTAiKQoJIC [...]
+<script src="data:application/x-javascript;base64,Ci8vIEluaXRpYWwgdGV4dCBsYWJlbCBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGxhYmVsX2luaXQgKHNlbGVjdGlvbikgewogICAgc2VsZWN0aW9uCiAgICAgICAgLmF0dHIoInRleHQtYW5jaG9yIiwgIm1pZGRsZSIpOwp9CgovLyBDb21wdXRlIGRlZmF1bHQgdmVydGljYWwgb2Zmc2V0IGZvciBsYWJlbHMKZnVuY3Rpb24gZGVmYXVsdF9sYWJlbF9keShzaXplLCB5LCB0eXBlX3ZhcixzZXR0aW5ncykgewogICAgaWYgKHkgPCAwICYmIHR5cGVfdmFyICE9PSB1bmRlZmluZWQgJiYgdHlwZV92YXIgPT0gImFycm93IikgewogICAgICAgIHJldHVybiAoTWF0aC5zcXJ0KHNpemUpIC8gMikgKy [...]
+<script src="data:application/x-javascript;base64,Ly8gWmVybyBob3Jpem9udGFsIGFuZCB2ZXJ0aWNhbCBsaW5lcwp2YXIgZHJhd19saW5lID0gZDMubGluZSgpCiAgICAueChmdW5jdGlvbihkKSB7cmV0dXJuIGQueDt9KQogICAgLnkoZnVuY3Rpb24oZCkge3JldHVybiBkLnk7fSk7CgpmdW5jdGlvbiBsaW5lX2luaXQoc2VsZWN0aW9uKSB7CiAgICBzZWxlY3Rpb24KCS5hdHRyKCJjbGFzcyIsICJsaW5lIik7CgogICAgcmV0dXJuIHNlbGVjdGlvbjsKfQoKZnVuY3Rpb24gbGluZV9mb3JtYXR0aW5nKHNlbGVjdGlvbiwgZGltcywgc2V0dGluZ3MsIHNjYWxlcykgewogICAgc2VsZWN0aW9uCgkuYXR0cigiZCIsIGZ1bmN0aW9uKGQpIH [...]
+<script src="data:application/x-javascript;base64,Ci8vIEluaXRpYWwgZWxsaXBzZSBhdHRyaWJ1dGVzCmZ1bmN0aW9uIGVsbGlwc2VfaW5pdChzZWxlY3Rpb24pIHsKICAgIHNlbGVjdGlvbgogICAgICAgIC5zdHlsZSgiZmlsbCIsICJub25lIik7Cn0KCi8vIEFwcGx5IGZvcm1hdCB0byBlbGxpcHNlCmZ1bmN0aW9uIGVsbGlwc2VfZm9ybWF0dGluZyhzZWxlY3Rpb24sIHNldHRpbmdzLCBzY2FsZXMpIHsKCiAgICAvLyBFbGxpcHNlcyBwYXRoIGZ1bmN0aW9uCiAgICB2YXIgZWxsaXBzZUZ1bmMgPSBkMy5saW5lKCkKICAgICAgICAueChmdW5jdGlvbihkKSB7IHJldHVybiBzY2FsZXMueChkLngpOyB9KQogICAgICAgIC55KGZ1bmN0aW [...]
+<script src="data:application/x-javascript;base64,Ly8gRm9ybWF0IGxlZ2VuZCBsYWJlbApmdW5jdGlvbiBsZWdlbmRfbGFiZWxfZm9ybWF0dGluZyAoc2VsZWN0aW9uKSB7CiAgICBzZWxlY3Rpb24KICAgICAgICAuc3R5bGUoInRleHQtYW5jaG9yIiwgImJlZ2lubmluZyIpCiAgICAgICAgLnN0eWxlKCJmaWxsIiwgIiMwMDAiKQogICAgICAgIC5zdHlsZSgiZm9udC13ZWlnaHQiLCAiYm9sZCIpOwp9CgovLyBDcmVhdGUgY29sb3IgbGVnZW5kCmZ1bmN0aW9uIGFkZF9jb2xvcl9sZWdlbmQoc3ZnLCBkaW1zLCBzZXR0aW5ncywgc2NhbGVzLCBkdXJhdGlvbikgewoKICAgIC8vIERlZmF1bHQgdHJhbnNpdGlvbiBkdXJhdGlvbiB0byAwCi [...]
+<script src="data:application/x-javascript;base64,Ly8gTGFzc28gZnVuY3Rpb25zIHRvIGV4ZWN1dGUgd2hpbGUgbGFzc29pbmcKdmFyIGxhc3NvX3N0YXJ0ID0gZnVuY3Rpb24obGFzc28pIHsKICAgIGxhc3NvLml0ZW1zKCkKICAgICAgICAuZWFjaChmdW5jdGlvbihkKXsKCSAgICBpZiAoZDMuc2VsZWN0KHRoaXMpLmNsYXNzZWQoJ2RvdCcpKSB7CiAgICAgICAgICAgICAgICBkLnNjYXR0ZXJEM19sYXNzb19kb3Rfc3Ryb2tlID0gZC5zY2F0dGVyRDNfbGFzc29fZG90X3N0cm9rZSA/IGQuc2NhdHRlckQzX2xhc3NvX2RvdF9zdHJva2UgOiBkMy5zZWxlY3QodGhpcykuc3R5bGUoInN0cm9rZSIpOwogICAgICAgICAgICAgICAgZC5zY2 [...]
+<script src="data:application/x-javascript;base64,Ly8gRXhwb3J0IHRvIFNWRyBmdW5jdGlvbgpmdW5jdGlvbiBleHBvcnRfc3ZnKHNlbCwgc3ZnLCBzZXR0aW5ncykgewogICAgdmFyIHN2Z19jb250ZW50ID0gc3ZnCiAgICAgICAgLmF0dHIoInhtbG5zIiwgImh0dHA6Ly93d3cudzMub3JnLzIwMDAvc3ZnIikKICAgICAgICAuYXR0cigidmVyc2lvbiIsIDEuMSkKICAgICAgICAubm9kZSgpLnBhcmVudE5vZGUuaW5uZXJIVE1MOwogICAgLy8gRGlydHkgZGlydHkgZGlydHkuLi4KICAgIHN2Z19jb250ZW50ID0gc3ZnX2NvbnRlbnQucmVwbGFjZSgvPGcgY2xhc3M9ImdlYXItbWVudVtcc1xTXSo/PFwvZz4vLCAnJyk7CiAgICBzdmdfY2 [...]
+<script src="data:application/x-javascript;base64,ZnVuY3Rpb24gc2NhdHRlckQzKCkgewoKICAgIHZhciB3aWR0aCA9IDYwMCwgLy8gZGVmYXVsdCB3aWR0aAoJaGVpZ2h0ID0gNjAwLCAvLyBkZWZhdWx0IGhlaWdodAoJZGltcyA9IHt9LAoJc2V0dGluZ3MgPSB7fSwKCXNjYWxlcyA9IHt9LAoJZGF0YSA9IFtdLAoJc3ZnLAoJem9vbSwgZHJhZzsKCiAgICAvLyBab29tIGJlaGF2aW9yCiAgICB6b29tID0gZDMuem9vbSgpCiAgICAgICAgLnNjYWxlRXh0ZW50KFswLCAzMl0pCiAgICAgICAgLm9uKCJ6b29tIiwgem9vbWVkKTsKCiAgICAvLyBab29tIGZ1bmN0aW9uCiAgICBmdW5jdGlvbiB6b29tZWQocmVzZXQpIHsKCXZhciByb290ID [...]
+
+
+<style type="text/css">code{white-space: pre;}</style>
+<style type="text/css">
+div.sourceCode { overflow-x: auto; }
+table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
+ margin: 0; padding: 0; vertical-align: baseline; border: none; }
+table.sourceCode { width: 100%; line-height: 100%; }
+td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
+td.sourceCode { padding-left: 5px; }
+code > span.kw { color: #007020; font-weight: bold; } /* Keyword */
+code > span.dt { color: #902000; } /* DataType */
+code > span.dv { color: #40a070; } /* DecVal */
+code > span.bn { color: #40a070; } /* BaseN */
+code > span.fl { color: #40a070; } /* Float */
+code > span.ch { color: #4070a0; } /* Char */
+code > span.st { color: #4070a0; } /* String */
+code > span.co { color: #60a0b0; font-style: italic; } /* Comment */
+code > span.ot { color: #007020; } /* Other */
+code > span.al { color: #ff0000; font-weight: bold; } /* Alert */
+code > span.fu { color: #06287e; } /* Function */
+code > span.er { color: #ff0000; font-weight: bold; } /* Error */
+code > span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
+code > span.cn { color: #880000; } /* Constant */
+code > span.sc { color: #4070a0; } /* SpecialChar */
+code > span.vs { color: #4070a0; } /* VerbatimString */
+code > span.ss { color: #bb6688; } /* SpecialString */
+code > span.im { } /* Import */
+code > span.va { color: #19177c; } /* Variable */
+code > span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
+code > span.op { color: #666666; } /* Operator */
+code > span.bu { } /* BuiltIn */
+code > span.ex { } /* Extension */
+code > span.pp { color: #bc7a00; } /* Preprocessor */
+code > span.at { color: #7d9029; } /* Attribute */
+code > span.do { color: #ba2121; font-style: italic; } /* Documentation */
+code > span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
+code > span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
+code > span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
+</style>
+
+
+
+<link href="data:text/css;charset=utf-8,body%20%7B%0Abackground%2Dcolor%3A%20%23fff%3B%0Amargin%3A%201em%20auto%3B%0Amax%2Dwidth%3A%20700px%3B%0Aoverflow%3A%20visible%3B%0Apadding%2Dleft%3A%202em%3B%0Apadding%2Dright%3A%202em%3B%0Afont%2Dfamily%3A%20%22Open%20Sans%22%2C%20%22Helvetica%20Neue%22%2C%20Helvetica%2C%20Arial%2C%20sans%2Dserif%3B%0Afont%2Dsize%3A%2014px%3B%0Aline%2Dheight%3A%201%2E35%3B%0A%7D%0A%23header%20%7B%0Atext%2Dalign%3A%20center%3B%0A%7D%0A%23TOC%20%7B%0Aclear%3A%20bot [...]
+
+</head>
+
+<body>
+
+
+
+
+<h1 class="title toc-ignore">Exploration of landscapes of phylogenetic trees</h1>
+<h4 class="author"><em>Thibaut Jombart, Michelle Kendall</em></h4>
+<h4 class="date"><em>2017-03-16</em></h4>
+
+
+
+<p><em>treespace</em> implements new methods for the exploration and analysis of distributions of phylogenetic trees for a given set of taxa.</p>
+<div id="installing-treespace" class="section level2">
+<h2>Installing <em>treespace</em></h2>
+<p>To install the development version from github:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(devtools)
+<span class="kw">install_github</span>(<span class="st">"thibautjombart/treespace"</span>)</code></pre></div>
+<p>The stable version can be installed from CRAN using:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">install.packages</span>(<span class="st">"treespace"</span>)</code></pre></div>
+<p>Then, to load the package, use:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(<span class="st">"treespace"</span>)</code></pre></div>
+</div>
+<div id="content-overview" class="section level2">
+<h2>Content overview</h2>
+<p>The main functions implemented in <em>treespace</em> are:</p>
+<ul>
+<li><p><strong><code>treespace</code></strong>: explore landscapes of phylogenetic trees</p></li>
+<li><p><strong><code>treespaceServer</code></strong>: open up an application in a web browser for an interactive exploration of the diversity in a set of trees</p></li>
+<li><p><strong><code>findGroves</code></strong>: identify clusters of similar trees</p></li>
+<li><p><strong><code>plotGroves</code></strong>: scatterplot of groups of trees, and <strong><code>plotGrovesD3</code></strong> which enables interactive plotting based on d3.js</p></li>
+<li><p><strong><code>medTree</code></strong>: find geometric median tree(s) to summarise a group of trees</p></li>
+</ul>
+<p>Other functions are central to the computations of distances between trees:</p>
+<ul>
+<li><p><strong><code>treeVec</code></strong>: characterise a tree by a vector</p></li>
+<li><p><strong><code>treeDist</code></strong>: find the distance between two tree vectors</p></li>
+<li><p><strong><code>multiDist</code></strong>: find the pairwise distances of a list of trees</p></li>
+<li><p><strong><code>refTreeDist</code></strong>: find the distances of a list of trees from a reference tree</p></li>
+<li><p><strong><code>tipDiff</code></strong>: for a pair of trees, list the tips with differing ancestry</p></li>
+<li><p><strong><code>plotTreeDiff</code></strong>: plot a pair of trees, highlighting the tips with differing ancestry</p></li>
+</ul>
+<p>Distributed datasets include:</p>
+<ul>
+<li><p><strong><code>woodmiceTrees</code></strong>: illustrative set of 201 trees built using the neighbour-joining and bootstrapping example from the woodmice dataset in the ape documentation.</p></li>
+<li><p><strong><code>DengueTrees</code></strong>: 500 trees sampled from a BEAST posterior set of trees from (Drummond and Rambaut, 2007)</p></li>
+<li><p><strong><code>DengueSeqs</code></strong>: 17 dengue virus serotype 4 sequences from (Lanciotti <em>et al</em>., 1997), from which the <code>DengueTrees</code> were inferred.</p></li>
+<li><p><strong><code>DengueBEASTMCC</code></strong>: the maximum clade credibility (MCC) tree from the <code>DengueTrees</code>.</p></li>
+</ul>
+</div>
+<div id="exploring-trees-with-treespace" class="section level2">
+<h2>Exploring trees with <em>treespace</em></h2>
+<p>We first load <em>treespace</em>, and the packages required for graphics:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">library</span>(<span class="st">"treespace"</span>)
+<span class="kw">library</span>(<span class="st">"adegenet"</span>)
+<span class="kw">library</span>(<span class="st">"adegraphics"</span>)
+<span class="kw">library</span>(<span class="st">"rgl"</span>)</code></pre></div>
+<p>The function <code>treespace</code> defines typologies of phylogenetic trees using a two-step approach:</p>
+<ol style="list-style-type: decimal">
+<li><p>perform pairwise comparisons of trees using various (Euclidean) metrics; by default, the comparison uses the Kendall and Colijn metric (Kendall and Colijn, 2016) which is described in more detail below; other metrics rely on tip distances implemented in <em>adephylo</em> (Jombart <em>et al.</em>, 2010) and <em>phangorn</em> (Schliep 2011).</p></li>
+<li><p>use Metric Multidimensional Scaling (MDS, aka Principal Coordinates Analysis, PCoA) to summarise pairwise distances between the trees as well as possible into a few dimensions; the output of the MDS is typically visualised using scatterplots of the first few Principal Components (PCs); this step relies on the PCoA implemented in <em>ade4</em> (Dray and Dufour, 2007).</p></li>
+</ol>
+<p>The function <code>treespace</code> performs both tasks, returning both the matrix of pairwise tree comparisons (<code>$D</code>), and the PCoA (<code>$pco</code>). This can be illustrated using randomly generated trees:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># generate list of trees</span>
+<span class="kw">set.seed</span>(<span class="dv">1</span>)
+x <-<span class="st"> </span><span class="kw">rmtree</span>(<span class="dv">10</span>, <span class="dv">20</span>)
+<span class="kw">names</span>(x) <-<span class="st"> </span><span class="kw">paste</span>(<span class="st">"tree"</span>, <span class="dv">1</span>:<span class="dv">10</span>, <span class="dt">sep =</span> <span class="st">""</span>)
+
+<span class="co"># use treespace</span>
+res <-<span class="st"> </span><span class="kw">treespace</span>(x, <span class="dt">nf=</span><span class="dv">3</span>)
+<span class="kw">names</span>(res)</code></pre></div>
+<pre><code>## [1] "D" "pco"</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">res</code></pre></div>
+<pre><code>## $D
+## tree1 tree2 tree3 tree4 tree5 tree6 tree7 tree8 tree9
+## tree2 26.00
+## tree3 31.06 26.74
+## tree4 42.85 42.12 44.44
+## tree5 30.66 27.71 27.37 44.79
+## tree6 36.50 31.18 30.18 41.81 31.59
+## tree7 34.64 28.71 29.48 40.35 31.11 32.37
+## tree8 28.97 26.29 24.45 43.74 23.47 30.41 29.00
+## tree9 29.63 27.42 27.48 45.61 26.31 30.89 29.77 24.60
+## tree10 34.87 30.00 29.44 44.97 34.06 31.05 34.41 31.54 32.59
+##
+## $pco
+## Duality diagramm
+## class: pco dudi
+## $call: dudi.pco(d = D, scannf = is.null(nf), nf = nf)
+##
+## $nf: 3 axis-components saved
+## $rank: 9
+## eigen values: 142.1 76.52 62.69 49.88 41.07 ...
+## vector length mode content
+## 1 $cw 9 numeric column weights
+## 2 $lw 10 numeric row weights
+## 3 $eig 9 numeric eigen values
+##
+## data.frame nrow ncol content
+## 1 $tab 10 9 modified array
+## 2 $li 10 3 row coordinates
+## 3 $l1 10 3 row normed scores
+## 4 $co 9 3 column coordinates
+## 5 $c1 9 3 column normed scores
+## other elements: NULL</code></pre>
+<p>Pairwise tree distances can be visualised using <em>adegraphics</em>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># table.image</span>
+<span class="kw">table.image</span>(res$D, <span class="dt">nclass=</span><span class="dv">30</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAACrFBMVEUAAAABAQEDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFDQ0NERERFRUVGRkZHR0dISEhKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVXV1dYWFhbW1tcXFxfX19gYGBhYWFjY2NkZGRlZWVmZmZnZ2doaGhpaWlqamptbW1ubm5zc [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># table.value with some customization</span>
+<span class="kw">table.value</span>(res$D, <span class="dt">nclass=</span><span class="dv">5</span>, <span class="dt">method=</span><span class="st">"color"</span>,
+ <span class="dt">symbol=</span><span class="st">"circle"</span>, <span class="dt">col=</span><span class="kw">redpal</span>(<span class="dv">5</span>))</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdd1yT1/s38JM9ICQEEBAQUZaiIsPFUBEUd124t99WrVvrqK0VtRb33tuK27oAB+IARHGAgoIgyAZZCRAICVn38we/x6qFEDIxXu8/+mqTc4dPM851j3POjcMwDAEAAABAv+B1HQAAAAAA6gcFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAANBDUOABAAAAPQQFHgAAA [...]
+<p>The best representation of these distances in a 2-dimensional space is given by the first 2 PCs of the MDS. These can be visualised using any scatter plotting tool; here we use the <em>treespace</em> function <code>plotGroves</code>, based on the <em>adegraphics</em> function <code>scatter</code>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotGroves</span>(res$pco, <span class="dt">lab.show=</span><span class="ot">TRUE</span>, <span class="dt">lab.cex=</span><span class="fl">1.5</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nO3dfVxUZf7/8eswg8wg98o9CqRmVKtbptYW0WJRQpaGba7mQ1Kr3WyhTexu29XdzdLtxrzd3aywFKvVtFbMijQrze5WS81UMAiQO1Fu5Ga4m/P743yX3+yIOMoMB655Pf8JrvOZcz5nxnjPmXPONYqqqgIAAMjFQ+8GAACA8xHwAABIiIAHAEBCBDwAABIyCiESEhIOHDigdycyaG9v9/DwUBRF70bcl9VqVRSFl0BHqqqqqurhwcGDbqxWa2Njo4+Pj96NuLX29naDweDqrfzsZz/75JNPzrbUKITIz8/fvXt3WFiYq1uR3v79+6Ojo/39/fVuxH0dO3bMbDZHRETo3Yj7qqysrKmpufjii/VuxH198803v [...]
+<p>Alternatively, <code>plotGrovesD3</code> creates interactive plots based on d3.js:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">plotGrovesD3</span>(res$pco, <span class="dt">treeNames=</span><span class="dv">1</span>:<span class="dv">10</span>)</code></pre></div>
+<p><div id="htmlwidget-6b73e56951f29c6e5bf8" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-6b73e56951f29c6e5bf8">{"x":{"data":{"x":[2.13035259412571,3.31143165077361,6.68261423648124,-34.2627208913964,7.25843567957564,-1.08828681782319,-2.41764971191633,6.88799030499781,8.36065794480431,3.13717501037757],"y":[-15.1746612118386,-4.3359528090973,2.8576050061263,-2.52929101464511,-5.13714617827929,14.9963546470384,0.889403081968251,-3.36078022712547,-3.2861444217133,15.0806131275662],"lab":[1,2,3,4,5,6,7,8,9,10],"key_var":[1,2, [...]
+<p>The functionality of <code>treespace</code> can be further illustrated using <em>ape</em>’s dataset <em>woodmouse</em>, from which we built the 201 trees supplied in <code>woodmiceTrees</code> using the neighbour-joining and bootstrapping example from the <em>ape</em> documentation.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="kw">data</span>(woodmiceTrees)
+wm.res <-<span class="st"> </span><span class="kw">treespace</span>(woodmiceTrees,<span class="dt">nf=</span><span class="dv">3</span>)
+
+<span class="co"># PCs are stored in:</span>
+<span class="kw">head</span>(wm.res$pco$li)</code></pre></div>
+<pre><code>## A1 A2 A3
+## 1 -0.9949 -1.363 -0.7918
+## 2 -0.6137 -1.014 -0.6798
+## 3 2.6667 4.219 -2.9293
+## 4 -13.6081 1.854 1.0947
+## 5 2.1980 4.176 -3.1960
+## 6 3.6013 4.865 2.9853</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># plot results</span>
+<span class="kw">plotGrovesD3</span>(wm.res$pco)</code></pre></div>
+<div id="htmlwidget-3b402b5ebc45916c1b91" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-3b402b5ebc45916c1b91">{"x":{"data":{"x":[-0.994915614079129,-0.613678626917784,2.6667063130703,-13.6081153840016,2.19796507262781,3.60128203945996,-7.93464330242989,-0.601509902833136,-0.994915614079123,-0.601509902833136,-0.607150138418815,10.3943189332891,-8.22061660863031,-0.542706411478826,3.33541847941513,-0.043828098018826,-0.164629339023312,2.79080622437025,10.5466992537476,-0.611741178555835,3.57629422667165,9.6450605977335,3.8 [...]
+<p>Packages such as <em>adegraphics</em> and <em>ggplot2</em> can be used to make alternative plots, for example visualising the density of points within the space.</p>
+<p>The <em>treespace</em> function <code>multiDist</code> simply performs the pairwise comparison of trees and outputs a distance matrix. This function may be preferable for large datasets, and when principal co-ordinate analysis is not required. It includes an option to save memory at the expense of computation time.</p>
+</div>
+<div id="identifying-clusters-of-trees" class="section level2">
+<h2>Identifying clusters of trees</h2>
+<p>Once a typology of trees has been derived using the approach described above, one may want to formally identify clusters of similar trees. One simple approach is:</p>
+<ol style="list-style-type: decimal">
+<li><p>select a few first PCs of the MDS (retaining signal but getting rid of random noise)</p></li>
+<li><p>derive pairwise Euclidean distances between trees based on these PCs</p></li>
+<li><p>use hierarchical clustering to obtain a dendrogram of these trees</p></li>
+<li><p>cut the dendrogram to obtain clusters</p></li>
+</ol>
+<p>In <em>treespace</em>, the function <code>findGroves</code> implements this approach, offering various clustering options (see <code>?findGroves</code>). Here we supply the function with our <code>treespace</code> output <code>wm.res</code> since we have already calculated it, but it is also possible to skip the steps above and directly supply <code>findGroves</code> with a multiPhylo list of trees.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">wm.groves <-<span class="st"> </span><span class="kw">findGroves</span>(wm.res, <span class="dt">nclust=</span><span class="dv">6</span>)
+<span class="kw">names</span>(wm.groves)</code></pre></div>
+<pre><code>## [1] "groups" "treespace"</code></pre>
+<p>Note that when the number of clusters (<code>nclust</code>) is not provided, the function will display a dendrogram and ask for a cut-off height.</p>
+<p>The results can be plotted directly using <code>plotGrovesD3</code> (see <code>?plotGrovesD3</code> for options):</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># basic plot</span>
+<span class="kw">plotGrovesD3</span>(wm.groves)</code></pre></div>
+<div id="htmlwidget-cbb267139d20e311da7f" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-cbb267139d20e311da7f">{"x":{"data":{"x":[-0.994915614079129,-0.613678626917784,2.6667063130703,-13.6081153840016,2.19796507262781,3.60128203945996,-7.93464330242989,-0.601509902833136,-0.994915614079123,-0.601509902833136,-0.607150138418815,10.3943189332891,-8.22061660863031,-0.542706411478826,3.33541847941513,-0.043828098018826,-0.164629339023312,2.79080622437025,10.5466992537476,-0.611741178555835,3.57629422667165,9.6450605977335,3.8 [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># alternative with improved legend and tooltip text, giving the tree numbers:</span>
+<span class="kw">plotGrovesD3</span>(wm.groves, <span class="dt">tooltip_text=</span><span class="kw">paste0</span>(<span class="st">"Tree "</span>,<span class="dv">1</span>:<span class="dv">201</span>), <span class="dt">legend_width=</span><span class="dv">50</span>, <span class="dt">col_lab=</span><span class="st">"Cluster"</span>)</code></pre></div>
+<div id="htmlwidget-9139e41b7206f95e465e" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-9139e41b7206f95e465e">{"x":{"data":{"x":[-0.994915614079129,-0.613678626917784,2.6667063130703,-13.6081153840016,2.19796507262781,3.60128203945996,-7.93464330242989,-0.601509902833136,-0.994915614079123,-0.601509902833136,-0.607150138418815,10.3943189332891,-8.22061660863031,-0.542706411478826,3.33541847941513,-0.043828098018826,-0.164629339023312,2.79080622437025,10.5466992537476,-0.611741178555835,3.57629422667165,9.6450605977335,3.8 [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># plot axes 2 and 3. This helps to show why, for example, clusters 2 and 4 have been identified as separate, despite them appearing to overlap when viewing axes 1 and 2.</span>
+<span class="kw">plotGrovesD3</span>(wm.groves, <span class="dt">xax=</span><span class="dv">2</span>, <span class="dt">yax=</span><span class="dv">3</span>, <span class="dt">tooltip_text=</span><span class="kw">paste0</span>(<span class="st">"Tree "</span>,<span class="dv">1</span>:<span class="dv">201</span>), <span class="dt">legend_width=</span><span class="dv">50</span>, <span class="dt">col_lab=</span><span class="st">"Cluster"</span>)</code></pre></div>
+<div id="htmlwidget-87312a4a1300b7fa8bdf" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-87312a4a1300b7fa8bdf">{"x":{"data":{"x":[-1.36296405257431,-1.0143380748759,4.21882824322934,1.85395115102287,4.17637909087138,4.86461034763142,-16.009575686826,-1.02771387775047,-1.36296405257431,-1.02771387775047,-1.02766987185401,-0.50552388611458,-10.0515267421666,-1.07229905286387,4.15752547173998,2.76392139550187,2.59796872098458,4.93883384448699,-10.7625404554933,-2.21247979854658,4.87226502578944,-9.5088708745062,3.321537765880 [...]
+<p>We can also plot in 3D:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># prepare a colour palette:</span>
+colours <-<span class="st"> </span><span class="kw">fac2col</span>(wm.groves$groups, <span class="dt">col.pal=</span>funky)
+<span class="kw">plot3d</span>(wm.groves$treespace$pco$li[,<span class="dv">1</span>],
+ wm.groves$treespace$pco$li[,<span class="dv">2</span>],
+ wm.groves$treespace$pco$li[,<span class="dv">3</span>],
+ <span class="dt">col=</span>colours, <span class="dt">type=</span><span class="st">"s"</span>, <span class="dt">size=</span><span class="fl">1.5</span>,
+ <span class="dt">xlab=</span><span class="st">""</span>, <span class="dt">ylab=</span><span class="st">""</span>, <span class="dt">zlab=</span><span class="st">""</span>)</code></pre></div>
+<div id="plotgroves_3Ddiv" class="rglWebGL">
+
+</div>
+<script type="text/javascript">
+var plotgroves_3Ddiv = document.getElementById("plotgroves_3Ddiv"),
+plotgroves_3Drgl = new rglwidgetClass();
+plotgroves_3Ddiv.width = 673;
+plotgroves_3Ddiv.height = 673;
+plotgroves_3Drgl.initialize(plotgroves_3Ddiv,
+{"material":{"color":"#000000","alpha":1,"lit":true,"ambient":"#000000","specular":"#FFFFFF","emission":"#000000","shininess":50,"smooth":true,"front":"filled","back":"filled","size":3,"lwd":1,"fog":false,"point_antialias":false,"line_antialias":false,"texture":null,"textype":"rgb","texmipmap":false,"texminfilter":"linear","texmagfilter":"linear","texenvmap":false,"depth_mask":true,"depth_test":"less","isTransparent":false},"rootSubscene":1,"objects":{"26":{"id":26,"type":"spheres","mate [...]
+plotgroves_3Drgl.prefix = "plotgroves_3D";
+</script>
+<p id="plotgroves_3Ddebug">
+You must enable Javascript to view this page properly.
+</p>
+<script>plotgroves_3Drgl.start();</script>
+</div>
+<div id="treespaceserver-a-web-application-for-treespace" class="section level2">
+<h2><code>treespaceServer</code>: a web application for <em>treespace</em></h2>
+<p>The functionalities of <code>treespace</code> are also available via a user-friendly web interface, running locally on the default web browser. It can be started by simply typing <code>treespaceServer()</code>. The interface allows you to import trees and run <code>treespace</code> to view and explore the tree space in 2 or 3 dimensions. It is then straightforward to analyse the tree space by varying <span class="math inline">\(\lambda\)</span>, looking for clusters using <code>findGr [...]
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAA9cAAAKlCAIAAABOiIgAAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsMAAA7DAcdvqGQAAP+lSURBVHhe7P13fBRHvv8L//58nufe1/3de+45Z/esvc4ZE4yc5LDYXqdd27s4sg4Y1tjY2LLBNjhhog0y2SYjgkiSCAIhIVAASUhIKKOcc44ogaSZkbCeT021hlF3S0hCEjOjz/s1r6G7qrq6qmeQ3lX6dvX/6iLdFBQUKFuEEEIIIYQMJ7TwK9DCCSGEEELIyEALvwItnBBCCCGEjAy08CvQwkm/MSn/EkIIIYQMCmsLrwn64c1ufgiqUVL7oCbI7arF+lNmqLjGc13Nwi/4rQ1w+kG+QvxqldR+Unfm3EAPuRb6fzpzSfvo2pUT1SatPnPBvKUwZG2oTf1+obgOM [...]
+</div>
+<div id="finding-median-trees" class="section level2">
+<h2>Finding median trees</h2>
+<p>When a set of trees have very similar structures, it makes sense to summarize them into a single ‘consensus’ tree. In <code>treespace</code>, this is achieved by finding the <em>median tree</em> for a set of trees according to the Kendall and Colijn metric. That is, we find the tree which is closest to the centre of the set of trees in the tree landscape defined in <code>treespace</code>. This procedure is implemented by the function <code>medTree</code>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># get first median tree</span>
+tre <-<span class="st"> </span><span class="kw">medTree</span>(woodmiceTrees)$trees[[<span class="dv">1</span>]]
+
+<span class="co"># plot tree</span>
+<span class="kw">plot</span>(tre,<span class="dt">type=</span><span class="st">"cladogram"</span>,<span class="dt">edge.width=</span><span class="dv">3</span>, <span class="dt">cex=</span><span class="fl">0.8</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAADAFBMVEUAAAABAQECAgIDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFCQkJDQ0NERERFRUVGRkZHR0dISEhJSUlKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVWVlZXV1dYWFhZWVlaWlpbW1tcXFxdXV1eXl5fX19gYGBhYWFiYmJjY2NkZ [...]
+<p>However, a more complete and accurate summary of the data can be given by finding a summary tree from each cluster. This is achieved using the <code>groups</code> argument of <code>medTree</code>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># find median trees for the 6 clusters identified earlier:</span>
+res <-<span class="st"> </span><span class="kw">medTree</span>(woodmiceTrees, wm.groves$groups)
+
+<span class="co"># there is one output per cluster</span>
+<span class="kw">names</span>(res)</code></pre></div>
+<pre><code>## [1] "1" "2" "3" "4" "5" "6"</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># get the first median of each</span>
+med.trees <-<span class="st"> </span><span class="kw">lapply</span>(res, function(e) <span class="kw">ladderize</span>(e$trees[[<span class="dv">1</span>]]))
+
+<span class="co"># plot trees</span>
+<span class="kw">par</span>(<span class="dt">mfrow=</span><span class="kw">c</span>(<span class="dv">2</span>,<span class="dv">3</span>))
+for(i in <span class="dv">1</span>:<span class="kw">length</span>(med.trees)) <span class="kw">plot</span>(med.trees[[i]], <span class="dt">main=</span><span class="kw">paste</span>(<span class="st">"cluster"</span>,i),<span class="dt">cex=</span><span class="fl">1.5</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAMAAABz4j/3AAADAFBMVEUAAAABAQECAgIDAwMEBAQFBQUGBgYHBwcICAgJCQkKCgoLCwsMDAwNDQ0ODg4PDw8QEBARERESEhITExMUFBQVFRUWFhYXFxcYGBgZGRkaGhobGxscHBwdHR0eHh4fHx8gICAhISEiIiIjIyMkJCQlJSUmJiYnJycoKCgpKSkqKiorKyssLCwtLS0uLi4vLy8wMDAxMTEyMjIzMzM0NDQ1NTU2NjY3Nzc4ODg5OTk6Ojo7Ozs8PDw9PT0+Pj4/Pz9AQEBBQUFCQkJDQ0NERERFRUVGRkZHR0dISEhJSUlKSkpLS0tMTExNTU1OTk5PT09QUFBRUVFSUlJTU1NUVFRVVVVWVlZXV1dYWFhZWVlaWlpbW1tcXFxdXV1eXl5fX19gYGBhYWFiYmJjY2NkZ [...]
+<p>These trees exhibit a number of topological differences, e.g. in the placement of the <strong>(1007S,1208S,0909S)</strong> clade. To examine the differences between the trees in a pairwise manner, we can use the function <code>plotTreeDiff</code>, for example:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># Compare median trees from clusters 1 and 2:</span>
+<span class="kw">plotTreeDiff</span>(med.trees[[<span class="dv">1</span>]],med.trees[[<span class="dv">2</span>]], <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdWXAc130v/u/p7tmBGQww2DcCIAmu4iqR2qWUpPjKvl6SKMm1y44T3/Lf/lddVZ6ih3+VY6VSrvKDK5XEDynXfUjKunVTtrwkcWRFlinLJmWKO8ENIAgSIPbBDDALZu/u83/oAWYGpkgAJAWy5/t5YAF9us80puo33z6nTw+FlBJERERkL8pGnwARERHdewx4IiIiG2LAExER2RADnoiIyIYY8ERERDbEgCciIrIhBjwREZENMeCJiIhsiAFPRERkQwx4IiIiG2LAExER2RADnoiIyIYY8ERERDbEgCciIrIhBjwREZENMeCJiIhsiAFPRERkQwx4IiIiG2LAUzVKJBLvvffe2bNnV2y/cePGsWPHNuSUi [...]
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># Compare median trees from clusters 1 and 4, and change aesthetics:</span>
+<span class="kw">plotTreeDiff</span>(med.trees[[<span class="dv">1</span>]],med.trees[[<span class="dv">4</span>]], <span class="dt">type=</span><span class="st">"cladogram"</span>, <span class="dt">use.edge.length=</span><span class="ot">FALSE</span>, <span class="dt">edge.width=</span><span class="dv">2</span>, <span class="dt">colourMethod=</span><span class="st">"palette"</span>,<span class="dt">palette=</span>spectral)</code></pre></div>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAIAAADLXliSAAAACXBIWXMAAA7DAAAOwwHHb6hkAAAgAElEQVR4nOzdd2AT5f8H8PdlNG3alA5KF6VspFDZsgRkqKjsUfb4iqKgIoLgQMUBWgf8EBmCCLJ3kSF7r7JnW6CsltI23W3SZufu98fVUAsio0+apJ/XX+1dcp9r4J3nnrvnnuMEQQAhhBBCXIukvHeAEEIIIWWPGnhCCCHEBVEDTwghhLggauAJIYQQF0QNPCGEEOKCqIEnhBBCXBA18IQQQogLogaeEEIIcUHUwBNCCCEuiBp4QgghxAVRA08IIYS4IGrgCSGEEBdEDTwhhBDigqiBJ4QQQlwQNfCEEEKIC6IGnhBCCHFB1MATQgghLogaeEIIIcQFUQNPKiKNRnPgwIHz58+XWn779u1jx46Vyy4RQhipsHmXlfcOE [...]
+<p>Performing this analysis enables the detection of distinct representative trees supported by data.</p>
+<p>Note that in this example we supplied the function <code>medTree</code> with the multiPhylo list of trees. A more computationally efficient process (at the expense of using more memory) is to use the option <code>return.tree.vectors</code> in the initial <code>treespace</code> call, and then supply these vectors directly to <code>medTree</code>. In this case, the tree indices are returned by <code>medTree</code> but the trees are not (since they were not supplied).</p>
+</div>
+<div id="emphasising-the-placement-of-certain-tips-or-clades" class="section level2">
+<h2>Emphasising the placement of certain tips or clades</h2>
+<p>In some analyses it may be informative to emphasise the placement of particular tips or clades within a set of trees. This can be particularly useful in large trees where the study is focused on a smaller clade. Priority can be given to a list of tips using the argument <code>emphasise.tips</code>, whose corresponding values in the vector comparison will be given a weight of <code>emphasise.weight</code> times the others (the default is 2, i.e. twice the weight).</p>
+<p>For example, if we wanted to emphasise where the woodmice trees agree and disagree on the placement of the <strong>(1007S,1208S,0909S)</strong> clade, we can simply emphasise that clade as follows:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">wm3.res <-<span class="st"> </span><span class="kw">treespace</span>(woodmiceTrees,<span class="dt">nf=</span><span class="dv">2</span>,<span class="dt">emphasise.tips=</span><span class="kw">c</span>(<span class="st">"No1007S"</span>,<span class="st">"No1208S"</span>,<span class="st">"No0909S"</span>),<span class="dt">emphasise.weight=</span><span class="dv">3</span>)
+
+<span class="co"># plot results</span>
+<span class="kw">plotGrovesD3</span>(wm3.res$pco)</code></pre></div>
+<div id="htmlwidget-d1e0ce19a386677ea71c" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-d1e0ce19a386677ea71c">{"x":{"data":{"x":[-0.594073207581344,-0.520474217124273,-4.29273420692203,-31.0045463450458,-4.43479335528005,8.36252332403474,2.52302297744348,-0.507192211060358,-0.594073207581332,-0.507192211060358,-0.518144836408109,24.5535073746063,-12.6258405735551,-0.480551349713738,8.35119300406132,-0.767202711076171,-0.794647388046402,-4.31673290260613,36.0482473263572,2.3268784850388,8.34249638256188,33.7608531371047,8. [...]
+<p>It can be seen from the scale of the plot and the density of clustering that the trees are now separated into more distinct clusters.</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r">wm3.groves <-<span class="st"> </span><span class="kw">findGroves</span>(woodmiceTrees,<span class="dt">nf=</span><span class="dv">3</span>,<span class="dt">nclust=</span><span class="dv">6</span>,<span class="dt">emphasise.tips=</span><span class="kw">c</span>(<span class="st">"No1007S"</span>,<span class="st">"No1208S"</span>,<span class="st">"No0909S"</span>),<span class="dt"> [...]
+<span class="kw">plotGrovesD3</span>(wm3.groves)</code></pre></div>
+<div id="htmlwidget-6b8b70809a7a9707a93f" style="width:672px;height:672px;" class="scatterD3 html-widget"></div>
+<script type="application/json" data-for="htmlwidget-6b8b70809a7a9707a93f">{"x":{"data":{"x":[-0.594073207581344,-0.520474217124273,-4.29273420692203,-31.0045463450458,-4.43479335528005,8.36252332403474,2.52302297744348,-0.507192211060358,-0.594073207581332,-0.507192211060358,-0.518144836408109,24.5535073746063,-12.6258405735551,-0.480551349713738,8.35119300406132,-0.767202711076171,-0.794647388046402,-4.31673290260613,36.0482473263572,2.3268784850388,8.34249638256188,33.7608531371047,8. [...]
+<p>Conversely, where the structure of a particular clade is not of interest (for example, lineages within an outgroup which was only included for rooting purposes), those tips can be given a weight less than 1 so as to give them less emphasis in the comparison. We note that although it is possible to give tips a weighting of 0, we advise caution with this as the underlying function will no longer be guaranteed to be a metric. That is, a distance of 0 between two trees will no longer nece [...]
+</div>
+<div id="method-characterising-a-tree-by-a-vector" class="section level2">
+<h2>Method: characterising a tree by a vector</h2>
+<p>Kendall and Colijn proposed a <a href="http://dx.doi.org/10.1093/molbev/msw124">metric</a> for comparing rooted phylogenetic trees (Kendall and COlijn, 2016). Each tree is characterised by a vector which notes the placement of the most recent common ancestor (MRCA) of each pair of tips, as demonstrated in this example:</p>
+<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAACAgAAANICAYAAABAfE8/AAAABHNCSVQICAgIfAhkiAAAAAlwSFlzAAAbrwAAG68BXhqRHAAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAACAASURBVHic7N15fFTV/f/x17kzk30nhJ0ggiKgCAZQXKlL1drW9ttarWgFtNja1u61/X77K3X5fmtrF21dUEjQulRs3erauu9IwKXsi+wQIGSfLLPc8/vj3iyECQkQlsj7+XjkMTP3nnvv584kcydzPudzzIoVK7YCfREREREREREREREREREREZFPq7IgXnLAj40xHx3qaERERERERERERERERERERKR7WWvHALcFAVzXXXjccce9dmhDEhERERERERERERERERERke62bNmymOM4OIc6EBERERERERERERERERERETnwl [...]
+<p>Specifically, it records the distance between the MRCA of a pair of tips <span class="math inline">\((i,j)\)</span> and the root in two ways: the number of edges <span class="math inline">\(m_{i,j}\)</span>, and the path length <span class="math inline">\(M_{i,j}\)</span>. It also records the length <span class="math inline">\(p_i\)</span> of each ‘pendant’ edge between a tip <span class="math inline">\(i\)</span> and its immediate ancestor. This procedure results in two vectors for a [...]
+<p><span class="math display">\[
+m(T) = (m_{1,2}, m_{1,3},...,m_{k-1,k},1,...,1)
+\]</span></p>
+<p>and</p>
+<p><span class="math display">\[
+M(T) = (M_{1,2}, M_{1,3},...,M_{k-1,k},p_1,...,p_k).
+\]</span></p>
+<p>In <span class="math inline">\(m(T)\)</span> we record the pendant lengths as 1, as each tip is 1 step from its immediate ancestor. We combine <span class="math inline">\(m\)</span> and <span class="math inline">\(M\)</span> with a parameter <span class="math inline">\(\lambda\)</span> between zero and one to weight the contribution of branch lengths, characterising each tree with a vector</p>
+<p><span class="math display">\[
+v_\lambda(T) = (1-\lambda)m(T) + \lambda M(T).
+\]</span></p>
+<p>This is implemented as the function <strong><code>treeVec</code></strong>. For example,</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># generate a random tree:</span>
+tree <-<span class="st"> </span><span class="kw">rtree</span>(<span class="dv">6</span>)
+<span class="co"># topological vector of mrca distances from root:</span>
+<span class="kw">treeVec</span>(tree)</code></pre></div>
+<pre><code>## [1] 0 1 2 2 3 0 0 0 0 1 1 1 3 2 2 1 1 1 1 1 1</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># vector of mrca distances from root when lambda=0.5:</span>
+<span class="kw">treeVec</span>(tree,<span class="fl">0.5</span>)</code></pre></div>
+<pre><code>## [1] 0.0000 0.9959 1.9436 1.9436 2.6194 0.0000 0.0000 0.0000 0.0000 0.9959
+## [11] 0.9959 0.9959 2.6110 1.9436 1.9436 0.5883 0.8042 0.5474 0.5886 0.7361
+## [21] 0.8265</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># vector of mrca distances as a function of lambda:</span>
+vecAsFunction <-<span class="st"> </span><span class="kw">treeVec</span>(tree,<span class="dt">return.lambda.function=</span><span class="ot">TRUE</span>)
+<span class="co"># evaluate the vector at lambda=0.5:</span>
+<span class="kw">vecAsFunction</span>(<span class="fl">0.5</span>)</code></pre></div>
+<pre><code>## [1] 0.0000 0.9959 1.9436 1.9436 2.6194 0.0000 0.0000 0.0000 0.0000 0.9959
+## [11] 0.9959 0.9959 2.6110 1.9436 1.9436 0.5883 0.8042 0.5474 0.5886 0.7361
+## [21] 0.8265</code></pre>
+<p>The metric – the distance between two trees – is the Euclidean distance between these vectors:</p>
+<p><span class="math display">\[
+d_\lambda(T_a, T_b) = || v_\lambda(T_a) - v_\lambda(T_b) ||.
+\]</span></p>
+<p>This can be found using <strong><code>treeDist</code></strong>:</p>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># generate random trees</span>
+tree_a <-<span class="st"> </span><span class="kw">rtree</span>(<span class="dv">6</span>)
+tree_b <-<span class="st"> </span><span class="kw">rtree</span>(<span class="dv">6</span>)
+
+<span class="co"># topological (lambda=0) distance:</span>
+<span class="kw">treeDist</span>(tree_a,tree_b) </code></pre></div>
+<pre><code>## [1] 3.162</code></pre>
+<div class="sourceCode"><pre class="sourceCode r"><code class="sourceCode r"><span class="co"># branch-length focused (lambda=1) distance:</span>
+<span class="kw">treeDist</span>(tree_a,tree_b,<span class="dv">1</span>)</code></pre></div>
+<pre><code>## [1] 2.694</code></pre>
+</div>
+<div id="references" class="section level2">
+<h2>References</h2>
+<ul>
+<li><p>Dray, S. and Dufour, A. B. (2007) The ade4 package: implementing the duality diagram for ecologists. Journal of Statistical Software 22(4): 1-20.</p></li>
+<li><p>Drummond, A. J. and Rambaut, A. (2007) BEAST: Bayesian evolutionary analysis by sampling trees. BMC Evolutionary Biology, 7(1), 214.</p></li>
+<li><p>Jombart, T., Balloux, F. and Dray, S. (2010) adephylo: new tools for investigating the phylogenetic signal in biological traits. Bioinformatics 26: 1907-1909. DOI: 10.1093/bioinformatics/btq292</p></li>
+<li><p>Kendall, M. and Colijn, C. (2016) Mapping phylogenetic trees to reveal distinct patterns of evolution. Molecular Biology and Evolution, first published online: June 24, 2016. DOI: 10.1093/molbev/msw124</p></li>
+<li><p>Lanciotti, R. S., Gubler, D. J. and Trent, D. W. (1997) Molecular evolution and phylogeny of dengue-4 viruses. Journal of General Virology, 78(9), 2279-2286.</p></li>
+<li><p>Schliep, K. P. (2011) phangorn: phylogenetic analysis in R. Bioinformatics 27(4): 592-593.</p></li>
+</ul>
+</div>
+<div id="authors-contributors" class="section level2">
+<h2>Authors / Contributors</h2>
+<p>Authors:</p>
+<ul>
+<li><p><a href="https://sites.google.com/site/thibautjombart/">Thibaut Jombart</a></p></li>
+<li><p><a href="http://www.imperial.ac.uk/people/m.kendall">Michelle Kendall</a></p></li>
+</ul>
+<p>Contributors:</p>
+<ul>
+<li><p><a href="http://www.well.ox.ac.uk/jacob-almagro-garcia">Jacob Almagro-Garcia</a></p></li>
+<li><p><a href="http://www.imperial.ac.uk/people/c.colijn">Caroline Colijn</a></p></li>
+</ul>
+<p>Maintainer of the CRAN version:</p>
+<ul>
+<li><a href="http://www.imperial.ac.uk/people/m.kendall">Michelle Kendall</a></li>
+</ul>
+</div>
+
+
+
+<!-- dynamically load mathjax for compatibility with self-contained -->
+<script>
+ (function () {
+ var script = document.createElement("script");
+ script.type = "text/javascript";
+ script.src = "https://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
+ document.getElementsByTagName("head")[0].appendChild(script);
+ })();
+</script>
+
+</body>
+</html>
diff --git a/inst/shiny/server.R b/inst/shiny/server.R
new file mode 100644
index 0000000..e2b2306
--- /dev/null
+++ b/inst/shiny/server.R
@@ -0,0 +1,1287 @@
+## DEFINE THE SERVER SIDE OF THE APPLICATION
+shinyServer(function(input, output, session) {
+ ## LOAD PACKAGES
+ require("ade4")
+ require("adegenet")
+ require("adegraphics")
+ require("ape")
+ require("distory")
+ require("fields")
+ require("htmlwidgets")
+ require("MASS")
+ require("phangorn")
+ require("treespace")
+
+ # suppress warning messages from creating temporary directories when 3d plotting
+ suppressWarnings(warning("dir.create(dir)"))
+
+ # the following resets the DensiTree plot every time the number of clusters changes - it was really slow without this
+ rvs <- reactiveValues(showDensiTree=NULL)
+ observeEvent(input$nclust, {
+ rvs$showDensiTree <- NULL
+ })
+ observeEvent(input$selectedDensiTree, {
+ rvs$showDensiTree <- 1
+ })
+
+
+
+ ######################################
+ ### Define main reactive functions
+ ######################################
+
+ getDataType <- reactive({
+ input$datatype
+ })
+
+ getDataSet <- reactive({
+ dataType <- getDataType()
+ if(dataType=="exDengue"){
+ return("Dengue")
+ }
+ if(dataType=="exWoodmice"){
+ return("woodmiceTrees")
+ }
+ else {
+ # extract file name
+ strsplit(input$datafile$name, '[.]')[[1]][1]
+ }
+ })
+
+ getSampleSize <- reactive({
+ input$sampleSize
+ })
+
+ getRandSamp <- reactive({
+ input$randSamp
+ })
+
+ ## GET DATA ##
+ getData <- reactive({
+ out <- NULL
+ dataType <- getDataType()
+ samp <- NULL
+
+ ## data is a distributed dataset
+ if(dataType=="exDengue"){
+ if (!exists("DengueTrees")) {
+ data("DengueTrees", package="treespace", envir=environment()) }
+ out <- get("DengueTrees")
+ }
+ if(dataType=="exWoodmice"){
+ if (!exists("woodmiceTrees")) {
+ data("woodmiceTrees", package="treespace", envir=environment()) }
+ out <- get("woodmiceTrees")
+ }
+
+ ## data is an input file
+ if(dataType=="file" && !is.null(input$datafile)){
+ ## need to rename input file
+ oldName <- input$datafile$datapath
+ extension <- adegenet::.readExt(input$datafile$name)
+ newName <- paste(input$datafile$datapath, extension, sep=".")
+ file.rename(oldName, newName)
+
+ if(tolower(extension) %in% c("rdata","rda")){
+ out <- get(load(newName))
+ }
+ if(tolower(extension) %in% c("rds")){
+ out <- readRDS(file=newName)
+ }
+ if(tolower(extension) %in% c("nex", "nexus")){
+ if(!require(ape)) stop("ape is required to read in NEXUS (.nex, .nexus) files")
+ out <- read.nexus(file=newName)
+ }
+
+ l <- length(out)
+
+ ## fix potential bug with input of two trees
+ validate(
+ need(l>2, "treespace expects at least three trees. The function treeDist is suitable for comparing two trees.")
+ )
+
+ # get a manageable number of trees by sampling if necessary
+ randSamp <- getRandSamp()
+ if(randSamp == TRUE){
+ sampleSize <- getSampleSize()
+ if (l>sampleSize) {
+ updateSliderInput(session, "sampleSize", "Size of random sample:", value=sampleSize, min=10, max=l, step=10)
+ samp <- sample(1:l,sampleSize)
+ out <- out[samp]
+ }
+ else{ # could only happen initially if <=10 trees supplied
+ updateSliderInput(session, "sampleSize", "Size of random sample:", value=l, min=3, max=l, step=1)
+ }
+
+ }
+
+ ## fix potential bug with tip labels - they need to match
+ tipLabelProblem <- FALSE
+ for (i in 1:length(out)) {
+ if (!setequal(out[[i]]$tip.label,out[[1]]$tip.label)) {
+ tipLabelProblem <- TRUE
+ validate(
+ need(!tipLabelProblem, "Trees must have identical tip labels for the current version of treespace")
+ )
+ }
+ }
+
+ }
+
+ validate(
+ need(!is.null(out), "Waiting for data")
+ )
+
+ ## fix potential bug with names - they need to be defined and unique
+ if(is.null(names(out))) {names(out) <- 1:length(out)}
+ if(length(unique(names(out)))!=length(out)){
+ warning("duplicates detected in tree labels - using generic names")
+ names(out) <- 1:length(out)
+ }
+
+ ## return data
+ # need to pass on the sample so that metaData can be sampled too
+ if(is.null(samp)) samp <- 1:length(out)
+
+ return(list(out=out,samp=samp))
+ }) # end getData
+
+ ## GET number of trees
+ getLengthData <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ return(length(x))
+ })
+
+ ## GET tree names
+ getTreeNames <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ return(names(x))
+ })
+
+ ## GET tip labels
+ getTipLabels <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ return(x[[1]]$tip.label)
+ })
+
+ ## GET tree method
+ getTreemethod <- reactive({
+ input$treemethod
+ }) # end getTreemethod
+
+ ## GET number of axes retained
+ getNaxes <- reactive({
+ if(is.null(input$naxes)){
+ naxes <- 3
+ }
+ else {
+ naxes <- as.numeric(input$naxes)
+ # when naxes changes we update the options available for the axes
+ # unfortunately I think they have to reset to their original 1,2,3 values
+ # but at least they now only do this when naxes changes; they used to also do it for lambda etc.
+
+ updateNumericInput(session,"xax", "Indicate the x axis", value=1, min=1, max=naxes)
+ updateNumericInput(session,"yax", "Indicate the y axis", value=2, min=1, max=naxes)
+
+ # (if relevant, update z axis selector too)
+ dim <- getPlotDim()
+ if (dim==3){
+ updateNumericInput(session,"zax", "Indicate the z axis", value=3, min=1, max=naxes)
+ }
+
+ }
+ return(naxes)
+ }) # end getNaxes
+
+ ## GET lambda
+ getLambda <- reactive({
+ l <- input$lambda
+ ## the following removes the lambda error messages:
+ validate(
+ need(!is.null(l), "Loading data set")
+ )
+ return(l)
+ }) # end getLambda
+
+ getTipsToEmphasise <- reactive({
+ input$whichTips
+ })
+
+ getEmphWeight <- reactive({
+ input$emphWeight
+ })
+
+ # GET the tree vectors as functions of lambda
+ getKCtreeVecs <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ tips <- getTipsToEmphasise()
+ weight <- getEmphWeight()
+ df <- sapply(x, function(i) treeVec(i, return.lambda.function=TRUE, emphasise.tips=tips, emphasise.weight = weight))
+ })
+
+
+ # GET the tree vectors evaluated at lambda
+ getKCtreeVecsAtLambda <- reactive({
+ vectors <- getKCtreeVecs()
+ l <- getLambda()
+ validate(
+ need(!is.null(vectors), "Analysing data")
+ )
+ t(sapply(vectors, function(i) i(l)))
+ })
+
+
+ ## GET KC matrix, evaluated at lambda
+ getKCmatrix <- reactive({
+ vls <- getKCtreeVecsAtLambda()
+ as.dist(rdist(vls))
+ }) # end getKCmatrix
+
+ ## GET medTrees for all clusters
+ getMedTreesList <- reactive({
+ mat <- getKCtreeVecsAtLambda()
+ groves <- getClusters()
+ if(!is.null(groves$groups)){ # if clusters have been picked
+ numGroups <- length(unique(groves$groups))
+ med <- medTree(mat,groves$groups)
+ lapply(1:numGroups, function(x) med[[x]]$treenumbers[[1]])
+ }
+ else{
+ medTree(mat)$treenumbers[[1]]
+ }
+ })
+
+ getMedTree <- reactive({
+ data <- getData()
+ x <- data$out
+ whichClust <- input$selectedMedTree
+ medList <- getMedTreesList()
+ if(whichClust=="all"){
+ x[[medList[[1]]]]
+ }
+ else{
+ x[[medList[[as.numeric(whichClust)]]]]
+ }
+ })
+
+ getMedTree1 <- reactive({
+ data <- getData()
+ x <- data$out
+ whichClust <- input$selectedMedTree1
+ medList <- getMedTreesList()
+ if(whichClust=="all"){
+ x[[medList[[1]]]]
+ }
+ else{
+ x[[medList[[as.numeric(whichClust)]]]]
+ }
+ })
+
+ getMedTree2 <- reactive({
+ data <- getData()
+ x <- data$out
+ whichClust <- input$selectedMedTree2
+ medList <- getMedTreesList()
+ if(whichClust=="all"){
+ x[[medList[[1]]]]
+ }
+ else{
+ x[[medList[[as.numeric(whichClust)]]]]
+ }
+ })
+
+
+ ## GET PCO analysis ##
+ getPCO <- reactive({
+ D <- getKCmatrix()
+ naxes <- getNaxes()
+ validate(
+ need(!is.null(D), "Analysing data")
+ )
+ validate(
+ need(!is.null(naxes), "Analysing data")
+ )
+ dudi.pco(D,scannf=FALSE,nf=naxes)
+ }) # end getPCO
+
+ ## GET ANALYSIS ##
+ getAnalysis <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+
+ naxes <- getNaxes()
+ TM <- getTreemethod()
+
+ ## select method used to summarise tree
+ if(!is.null(TM)){
+ if(TM %in% c("BHV","KF","RF","wRF","patristic","nNodes","Abouheif","sumDD")){
+ ## run treespace (suppress warnings about rootedness etc.)
+ res <- suppressWarnings(treespace(x, method=TM, nf=naxes))
+ }
+ else if(TM=="metric"){
+ ## don't actually need to call treespace here, to save on recomputation for varying lambda
+ D <- getKCmatrix()
+ pco <- getPCO()
+ res <- list(D=D, pco=pco)
+ }
+ }
+
+ ## return results
+ return(res)
+ }) # end getAnalysis
+
+ #################################################
+ ### Little "get" functions to support getClusters
+ #################################################
+
+ getNclust <- reactive({
+ if(!is.null(input$nclust)) {
+ input$nclust
+ } else {
+ 2
+ }
+ })
+
+ getClustmethod <- reactive({
+ input$clustmethod
+ })
+
+
+ ################
+ ## GET CLUSTERS
+ ################
+
+ getClusters <- reactive({
+ ## stop if clusters not required
+ if(!input$findClusters) return(NULL)
+ else if(input$clusterType=="meta") return(NULL)
+
+ ## reset the densiTree plot to accommodate number of clusters available
+ choices <- getClustChoices()
+ updateSelectInput(session, "selectedDensiTree", "Choose collection of trees to view in densiTree plot",
+ choices=choices, selected="")
+
+ ## reset the median tree choices to accommodate number of clusters available
+ updateSelectInput(session, "selectedMedTree", "Median tree from:",
+ choices=choices, selected="all")
+ updateSelectInput(session, "selectedMedTree1", "Median tree from:",
+ choices=choices, selected="all")
+ updateSelectInput(session, "selectedMedTree2", "Median tree from:",
+ choices=choices, selected="all")
+
+ ## get dataset
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+
+ naxes <- getNaxes()
+ TM <- getTreemethod()
+ nclust <- getNclust()
+ clustmethod <- getClustmethod()
+
+ ## select method used to summarise tree
+ if(!is.null(TM)){
+ if(TM %in% c("BHV","RF","KF","patristic","nNodes","Abouheif","sumDD")){
+ ## run findGroves
+ res <- findGroves(x, method=TM, nf=naxes, nclust=nclust, clustering=clustmethod)
+ } else if(TM=="metric"){
+ res <- findGroves(getAnalysis(), nclust=nclust, clustering=clustmethod)
+ }
+ }
+
+ ## return results
+ return(res)
+
+ }) # end getClusters
+
+
+
+ ## DYNAMIC UI COMPONENTS ##
+ ## SELECTION OF MDS AXES
+ output$naxes <- renderUI({
+ if(!is.null(getLengthData())) {
+ nmax <- getLengthData()
+ } else {
+ nmax <- 100
+ }
+ sliderInput("naxes", "Number of MDS axes retained:", min=2, max=nmax, value=3, step=1)
+ })
+
+ ## VALUE OF LAMBDA FOR METRIC
+ output$lambda <- renderUI({
+ ## if KC metric has been chosen
+ TM <- getTreemethod()
+ if(TM=="metric") {
+ sliderInput("lambda", "Value of lambda", min=0, max=1, value=0, step=0.01)
+ } else {
+ NULL
+ }
+ })
+
+ ## SELECTION OF NUMBER OF CLUSTERS
+ output$nclust <- renderUI({
+ if(!is.null(data <- getData())) {
+ nmax <- length(data$out)
+ } else {
+ nmax <- 100
+ }
+ nmax <- min(20, nmax)
+ sliderInput("nclust", "Number of clusters:", min=2, max=nmax, value=2, step=1)
+ })
+
+ ## SELECTION OF TIPS
+ output$whichTips <- renderUI({
+ # populate selection box with tip choices
+ allTips <- getTipLabels()
+ choices <- c("",allTips)
+ names(choices) <- c("Type here to search tip names",allTips)
+ selectInput("whichTips", "Select one or more tips to emphasise:",
+ choices=choices, selected=NULL, selectize=TRUE, multiple=TRUE)
+ })
+
+ ## GET METADATA ## for colouring trees by type
+ getMetaData <- reactive({
+ out <- NULL
+ data <- getData()
+ samp <- data$samp
+ ## data is an input file
+ if(input$clusterType=="meta" && !is.null(input$metadatafile)){
+ ## need to rename input file
+ oldName <- input$metadatafile$datapath
+ extension <- adegenet::.readExt(input$metadatafile$name)
+ newName <- paste(input$metadatafile$datapath, extension, sep=".")
+ file.rename(oldName, newName)
+
+ if(tolower(extension) %in% c("rdata","rda")){
+ out <- get(load(newName))
+ validate(
+ need(class(out)%in%c("numeric","character","list","factor"), paste0("The class of the input is ", class(out), ". Please upload a single object of class list, numeric, factor or character, whose length is the same as the number of trees."))
+ )
+
+ }
+ if(tolower(extension) %in% c("csv")){
+ csvfile <- read.csv(file=newName, header=FALSE)
+ out <- csvfile[,1]
+ validate(
+ need(class(out)%in%c("numeric","character","list","factor"), paste0("The first column of the csv file has been extracted. However, the class of the input is ", class(out), ". Please alter the entries so that it can be read by R as an object of class list, numeric, factor or character, whose length is the same as the number of trees."))
+ )
+ }
+
+ if(class(out)=="list") {out <- unlist(out)}
+
+ l <- getLengthData()
+ out <- out[samp]
+ validate(
+ need(length(out)==l, paste0("The length of the metadata must be the same as the number of trees, which is ", l, ". However, the length of the input is ", length(out)))
+ )
+
+ }
+
+ ## return metadata
+ return(out)
+ }) # end getMetaData
+
+
+ ######################################################
+ ### Little "get" functions to support getPlot
+ ######################################################
+
+ getPalette <- reactive({
+ get(input$palette)
+ })
+
+ getLabcol <- reactive({
+ ifelse(!is.null(input$labcol), input$labcol, "black")
+ })
+
+ getBgcol <- reactive({
+ ifelse(!is.null(input$bgcol), input$bgcol, "white")
+ })
+
+ getXax <- reactive({
+ input$xax
+ })
+
+ getYax <- reactive({
+ input$yax
+ })
+
+ getZax <- reactive({
+ input$zax
+ })
+
+ getShowlabels <- reactive({
+ input$showlabels
+ })
+
+ getLabelsize <- reactive({
+ input$labelsize
+ })
+
+ getPointsize <- reactive({
+ input$pointsize
+ })
+
+ getPlotFunction <- reactive({
+ input$graphics
+ })
+
+ ##############
+ ## GET plot
+ ##############
+
+ ## GET whether plot is 2D (default) or 3D
+ getPlotDim <- reactive({
+ plotDim <- input$plot3D
+ if(is.null(plotDim)) {2} # needed during startup
+ else {return(plotDim)}
+ })
+
+ ## GET 2D plot
+ getPlot <- reactive({
+
+ res <- getAnalysis()
+ pal <- getPalette()
+ labcol <- getLabcol()
+ groves <- getClusters()
+ treeTypes <- getMetaData()
+ showlabels <- getShowlabels()
+ pointSize <- getPointsize()
+
+ if(!is.null(treeTypes)) {
+ groups <- treeTypes
+ cols <- fac2col(1:length(unique(groups)),col.pal=pal)
+ }
+ else if (!is.null(groves)) {
+ groups <- groves$groups
+ cols <- fac2col(1:length(unique(groups)),col.pal=pal)
+ }
+ else {
+ groups <- NULL
+ n <- getLengthData()
+ cols <- rep(labcol, n)
+ }
+
+
+ ## get aesthetics
+ xax <- getXax()
+ yax <- getYax()
+
+ plotFunction <- getPlotFunction()
+
+ if (plotFunction==1) {
+ transitions <- input$transitions
+
+ # labels and tree names
+ treeNames <- getTreeNames()
+ if (is.null(groups)) { tooltips <- paste0("Tree ", treeNames) }
+ else { tooltips <- paste0("Tree ",treeNames,", cluster ",groups) }
+
+ treeLabels <- NULL
+ labelsize <- NULL
+
+ if(showlabels==TRUE) {
+ treeLabels <- getTreeNames()
+ labelsize <- getLabelsize()
+ }
+
+ pointOpacity <- input$pointopacity
+
+ plot <- plotGrovesD3(res$pco, xax=xax, yax=yax,
+ treeNames=treeLabels, labels_size=labelsize*5,
+ point_size = pointSize*40, point_opacity = pointOpacity,
+ groups=groups, colors=cols, col_lab="Cluster",
+ xlab=paste0("Axis ",xax), ylab=paste0("Axis ",yax),
+ tooltip_text = tooltips,
+ transitions=transitions, legend_width=50
+ )
+ # later could add:
+ # other categories of variation e.g. metadata using symbols
+ }
+
+ else { # i.e. plotFunction==2
+ bgcol <- getBgcol()
+ scattertype <- input$scattertype
+ screemds <- input$screemds
+ optimlabels <- input$optimlabels
+ labelsize <- getLabelsize()
+
+ if(is.null(groves)){
+ plot <- plotGroves(res$pco, groups=treeTypes, type=scattertype, xax=xax, yax=yax,
+ scree.posi=screemds, lab.optim=optimlabels,
+ lab.show=showlabels, lab.cex=labelsize,
+ lab.col=labcol,
+ point.cex=pointSize, bg=bgcol, col.pal=pal)
+ }
+ else {
+ ## plot with statistically identified groups
+ plot <- plotGroves(groves, type=scattertype, xax=xax, yax=yax,
+ scree.posi=screemds, lab.optim=optimlabels,
+ lab.show=showlabels, lab.cex=labelsize,
+ lab.col=labcol,
+ point.cex=pointSize, bg=bgcol, col.pal=pal)
+ }
+ }
+ return(plot)
+ })
+
+ getDistPlot <- reactive({
+ res <- getAnalysis()
+ refTree <- input$selectedRefTree
+ validate(
+ need(refTree!="", "Select a reference tree")
+ )
+ groves <- getClusters()
+ treeNames <- getTreeNames()
+ pal <- getPalette()
+ dists <- as.matrix(res$D)[refTree,]
+ g1 <- s1d.label(dists, labels=treeNames, poslabel="regular", p1d.horizontal=FALSE, p1d.reverse=TRUE, plot=FALSE)
+ if(!is.null(groves$groups)){
+ pal <- getPalette()
+ nclusts <- getNclust()
+ ordercols <- fac2col(1:nclusts, col.pal=pal)
+ g2 <- s1d.boxplot(dists,fac=groves$groups, col=ordercols, p1d.horizontal=FALSE, plot=FALSE)
+ ADEgS(c(g1, g2), layout = c(1, 2))
+ }
+ else{
+ g1
+ }
+
+ })
+
+ getPlotType <- reactive({
+ input$plotType
+ })
+
+ ## TREESPACE IMAGE ##
+ output$treespacePlot <- renderUI({
+ type <- getPlotType()
+ if (type==1){ # i.e. full tree landscape
+ plotFunction <- getPlotFunction()
+ if (plotFunction==1) { # i.e. scatterD3
+ scatterD3Output("scatterplotD3")
+ }
+ else { # i.e. adegraphics
+ plotOutput("scatterplot", height = "800px")
+ }
+ }
+ else{ # i.e. distance from reference tree plot
+ i <- input$stretch
+ height <- as.character(paste0(i,"px"))
+ plotOutput("DistPlot", height = height)
+ }
+ })
+
+ # repeat treespacePlot for tree viewer tab
+ output$scatterplotD3TreeTab <- renderScatterD3({
+ plotFunction <- getPlotFunction() # need to do this or you get an error when switching between plotGroves and plotGrovesD3
+ if (plotFunction==1) {
+ withProgress(message = 'Loading plot',
+ value = 0, {
+ for (i in 1:15) {
+ incProgress(1/15)
+ }
+ myplot <- getPlot()
+ myplot
+ })
+ }
+ })
+
+ output$treespacePlotTreeTab <- renderUI({
+ scatterD3Output("scatterplotD3TreeTab")
+ })
+
+ # 3d output
+ output$treespacePlot3D <- renderRglwidget({
+ validate(
+ need(packageVersion("rgl")>='0.96.0',
+ paste0("You are running version ",packageVersion("rgl")," of the package rgl, which may not contain all the necessary features for 3D plotting (which are based on the old, separate rglwidget package). Please update to the latest version.")
+ ))
+ plot <- getPlot3d()
+ plot
+ rglwidget()
+ })
+
+
+ output$scatterplotD3 <- renderScatterD3({
+ plotFunction <- getPlotFunction() # need to do this or you get an error when switching between plotGroves and plotGrovesD3
+ if (plotFunction==1) {
+ withProgress(message = 'Loading plot',
+ value = 0, {
+ for (i in 1:15) {
+ incProgress(1/15)
+ }
+ myplot <- getPlot()
+ myplot
+ })
+ }
+ })
+
+ output$scatterplot <- renderPlot({
+ plotFunction <- getPlotFunction() # need to do this or you get an error when switching between plotGroves and plotGrovesD3
+ if (plotFunction==2) {
+ withProgress(message = 'Loading plot',
+ value = 0, {
+ for (i in 1:15) {
+ incProgress(1/15)
+ }
+ myplot <- getPlot()
+ myplot
+ })
+ }
+ }, res=120)
+
+ output$DistPlot <- renderPlot({
+ withProgress(message = 'Loading plot',
+ value = 0, {
+ for (i in 1:15) {
+ incProgress(1/15)
+ }
+ myplot <- getDistPlot()
+ plot(myplot)
+ })
+ }, res=120)
+
+ getPlot3d <- reactive({
+ res <- getAnalysis()
+ xax <- getXax()
+ yax <- getYax()
+ zax <- getZax()
+ col <- getLabcol()
+
+ # show clusters?
+ clusts <- getClusters()
+ treeTypes <- getMetaData()
+ if (!is.null(clusts)){
+ pal <- getPalette()
+ cols3d <- fac2col(clusts$groups,col.pal=pal)
+ }
+ else if (!is.null(treeTypes)) {
+ pal <- getPalette()
+ cols3d <- fac2col(treeTypes,col.pal=pal)
+ }
+ else{cols3d <- col}
+
+ rgl::plot3d(res$pco$li[,xax],res$pco$li[,yax],res$pco$li[,zax],
+ type="s", size=getPointsize(),
+ xlab="",ylab="",zlab="",
+ col=cols3d, add=FALSE)
+ })
+
+
+ ## make Shepard plot
+ getShep <- reactive({
+ res <- getAnalysis()
+ dim <- getPlotDim()
+ xax <- getXax()
+ yax <- getYax()
+
+ if (dim==2) { shep <- Shepard(res$D,as.matrix(res$pco$li[,xax],res$pco$li[,yax])) }
+
+ else {
+ zax <- getZax()
+ shep <- Shepard(res$D,as.matrix(res$pco$li[,xax],res$pco$li[,yax],res$pco$li[,zax]))
+ }
+ })
+
+ output$shepPlot <- renderPlot({
+ withProgress(message = 'Loading Shepard plot',
+ value = 0, {
+ for (i in 1:15) {
+ incProgress(1/15)
+ }
+ shep <- getShep()
+ labcol <- getLabcol()
+ plot(shep, pch=19, cex=0.5, col=labcol, xlab="Distance in tree space", ylab="MDS distance")
+
+ })
+ }, res=120)
+
+ output$shep <- renderUI({
+ plotOutput("shepPlot", width="800px", height="800px")
+ })
+
+
+ ## make screeplot
+ output$screePlot <- renderPlot({
+ res <- getAnalysis()
+ labcol <- getLabcol()
+ barplot(res$pco$eig, col=labcol)
+ }, res=120)
+
+ output$scree <- renderUI({
+ plotOutput("screePlot")
+ })
+
+ # get tree and aesthetics for plotting tree
+ getTreeChoice <- reactive({
+ input$treeChoice
+ })
+
+ getTreeChoice1 <- reactive({
+ input$treeChoice1
+ })
+
+ getTreeChoice2 <- reactive({
+ input$treeChoice2
+ })
+
+ getTree <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ treechoice <- getTreeChoice()
+ if(treechoice=="med"){
+ tre <- getMedTree()
+ }
+ else{
+ g <- input$selectedGenTree
+ validate(
+ need(g!="", "Select tree to view")
+ )
+ treeNum <- as.numeric(g)
+ tre <- x[[treeNum]]
+ }
+
+ # return tree
+ if(!is.null(tre)){
+ if(input$ladderize){
+ tre <- ladderize(tre)
+ }
+ return(tre)
+ }
+ else{
+ NULL
+ }
+ })
+
+ getTree1 <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ treechoice <- getTreeChoice1()
+ if(treechoice=="med"){
+ tre <- getMedTree1()
+ }
+ else{
+ g <- input$selectedGenTree1
+ validate(
+ need(g!="", "Select first tree to compare")
+ )
+ treeNum <- as.numeric(g)
+ tre <- x[[treeNum]]
+ }
+
+ # return tree
+ if(!is.null(tre)){
+ if(input$ladderize){
+ tre <- ladderize(tre)
+ }
+ return(tre)
+ }
+ else{
+ NULL
+ }
+ })
+
+ getTree2 <- reactive({
+ data <- getData()
+ x <- data$out
+ validate(
+ need(!is.null(x), "Loading data set")
+ )
+ treechoice <- getTreeChoice2()
+ if(treechoice=="med"){
+ tre <- getMedTree2()
+ }
+ else{
+ g <- input$selectedGenTree2
+ validate(
+ need(g!="", "Select second tree to compare")
+ )
+ treeNum <- as.numeric(g)
+ tre <- x[[treeNum]]
+ }
+
+ # return tree
+ if(!is.null(tre)){
+ if(input$ladderize){
+ tre <- ladderize(tre)
+ }
+
+ return(tre)
+ }
+ else{
+ NULL
+ }
+ })
+
+ getTipDiff <- reactive({
+ tr1 <- getTree1()
+ tr2 <- getTree2()
+ tipDiff(tr1,tr2)
+ })
+
+ getTipDiffTable <- reactive({
+ tipDiff <- getTipDiff()
+ # data frame of the tips with differences:
+ if (!is.null(tipDiff)) {
+ out <- tipDiff[which(tipDiff[,2]!=0),]
+ rownames(out) <- NULL
+ colnames(out) <- c("Tips with ancestral differences","No. of differences")
+ return(out)
+ }
+ else {NULL}
+ })
+
+
+ ## PHYLOGENY ##
+ output$tree <- renderPlot({
+ tre <- getTree()
+ if(!is.null(tre)){
+
+ ## plot tree ##
+ par(mar=rep(2,4), xpd=TRUE)
+ plot(tre, type=input$treetype,
+ use.edge.length=as.logical(input$edgelengths),
+ show.tip.lab=input$showtiplabels,
+ tip.color=input$tiplabelcolour,
+ font=as.numeric(input$tiplabelfont),
+ cex=input$tiplabelsize,
+ direction=input$treedirection,
+ edge.width=input$edgewidth,
+ edge.color=input$edgecolor
+ )
+ }
+ })
+
+ output$treeDiff <- renderPlot({
+ tr1 <- getTree1()
+ tr2 <- getTree2()
+ tipDiff <- getTipDiff()
+ CM <- c("ramp","palette")[[as.numeric(input$colourMethod)]]
+ tipPal <- c(funky, spectral, seasun, lightseasun, deepseasun,
+ rainbow, azur, wasp)[[as.numeric(input$tipPalette)]]
+
+ if(!is.null(tr1)&&!is.null(tr2)){
+
+ ## plot tree comparison ##
+ #par(mar=rep(2,4), xpd=TRUE)
+ plotTreeDiff(tr1,tr2,
+ tipDiff = tipDiff,
+ baseCol=input$basetiplabelcolour,
+ col1=input$minortiplabelcolour,
+ col2=input$majortiplabelcolour,
+ colourMethod=CM,
+ palette=tipPal,
+ type=input$treetype,
+ use.edge.length=as.logical(input$edgelengths),
+ show.tip.lab=input$showtiplabels,
+ font=as.numeric(input$tiplabelfont),
+ cex=input$tiplabelsize,
+ direction=input$treedirection,
+ edge.width=input$edgewidth,
+ edge.color=input$edgecolor
+ )
+ }
+ })
+
+ output$tipDiffTable <- renderTable({
+ table <- getTipDiffTable()
+ })
+
+ ## DENSITREE
+
+ # The slider bar is always at least 2 even when clusters haven't
+ # been requested, so we can't just use getNclust.
+
+ getNclustForDensiTree <- reactive({
+ if(input$clusterType=="meta"){NULL}
+ else{input$nclust}
+ })
+
+ getClustChoices <- reactive({
+ nclust <- getNclustForDensiTree()
+ if(is.null(nclust)){
+ choices <- c("","all")
+ names(choices) <- c("Choose one","All trees")
+ }
+ else{
+ choices <- c("",1:nclust,"all")
+ names(choices) <- c("Choose one",paste0("Cluster ",1:nclust),"All trees")
+ }
+ return(choices)
+ })
+
+ getDensiTree <- reactive({
+ clusterNo <- input$selectedDensiTree
+ if(clusterNo==""){
+ NULL
+ }
+ else if(clusterNo=="all"){
+ data <- getData()
+ x <- data$out
+ medList <- getMedTreesList()
+ med <- x[[medList[[1]]]]
+ return(list(trees=x,con=med))
+ }
+ else{
+ data <- getData()
+ x <- data$out
+ clusts <- getClusters()
+ clustTrees <- x[which(clusts$groups==as.numeric(clusterNo))]
+ medList <- getMedTreesList()
+ med <- x[[medList[[as.numeric(clusterNo)]]]]
+ return(list(trees=clustTrees, con=med))
+ }
+ })
+
+ output$densiTree <- renderPlot({
+ if(is.null(rvs$showDensiTree)) {NULL}
+ else{
+ withProgress(message = 'Loading densiTree plot',
+ detail = 'Note: the final stage of this process may take a while for large sets of trees',
+ value = 0, {
+ for (i in 1:30) {
+ incProgress(1/30)
+ }
+ clustTrees <- getDensiTree()
+ densiTree(clustTrees$trees, col=4, consensus=clustTrees$con, alpha=input$alpha, scaleX=input$scaleX)
+ })
+ }
+ })
+
+
+ ## EXPORT TREES ##
+ output$exporttrees <- downloadHandler(
+ filename = function() { paste(getDataSet(), '.nex', sep='') },
+ content = function(file) {
+ if(!require(ape)) stop("ape is required to save trees into nexus file")
+ data <- getData()
+ x <- data$out
+ if(!is.null(x) && inherits(x, "multiPhylo")) ape::write.nexus(x, file=file)
+ })
+
+ ## EXPORT ANALYSIS TO CSV ##
+ output$exportrestocsv <- downloadHandler(
+ filename = function() { paste(getDataSet(), "-analysis", '.csv', sep='') },
+ content = function(file) {
+ data <- getData()
+ x <- data$out
+ res <- getClusters()
+ if(!is.null(res)){
+ tab <- cbind.data.frame(res$groups, res$treespace$pco$li)
+ names(tab) <- c("cluster", paste("PC", 1:ncol(res$treespace$pco$li), sep="."))
+ row.names(tab) <- names(x)
+ } else{
+ res <- getAnalysis()
+ tab <- res$pco$li
+ names(tab) <- paste("PC", 1:ncol(tab), sep=".")
+ row.names(tab) <- names(x)
+ }
+ if(!is.null(res)) write.csv(tab, file=file)
+ })
+
+
+ ## EXPORT ANALYSIS TO RDATA ##
+ output$exportrestordata <- downloadHandler(
+ filename = function() { paste(getDataSet(), "-analysis", '.RData', sep='') },
+ content = function(file) {
+ data <- getData()
+ trees <- data$out
+ analysis <- getClusters()
+ if(is.null(analysis)) analysis <- getAnalysis()
+ if(!is.null(analysis)) {
+ save(trees, analysis, file=file)
+ }
+ })
+
+
+ ## EXPORT 2D plotGroves MDS PLOT AS png ##
+ output$downloadMDS <- downloadHandler(
+ filename = function() {
+ paste0(getDataSet(),"scape2D.png")
+ },
+ content = function(file) {
+ myplot <- getPlot()
+ png(file=file, width = 10, height = 10, units = 'in', res = 500)
+ plot(myplot)
+ dev.off()
+
+ contentType = 'image/png'
+ }
+ )
+
+ ## EXPORT 2D plotGrovesD3 PLOT AS html ##
+ output$downloadMDS2Dhtml <- downloadHandler(
+ filename = function() {
+ paste0(getDataSet(),"scape2D.html")
+ },
+ content = function(file) {
+ htmlwidgets::saveWidget(
+ getPlot(),
+ file=file,
+ selfcontained = TRUE)
+ },
+ contentType = 'html'
+ )
+
+
+ ## EXPORT 3D MDS PLOT AS html ##
+ output$downloadMDS3Dhtml <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"scape3D.html") },
+ content = function(file) {
+ options(rgl.useNULL=FALSE)
+ myplot <- getPlot3d()
+ myplot
+ rglwidget()
+ rgl::writeWebGL(dir=getwd(), filename=file, snapshot=TRUE, width = 500, reuse=TRUE)
+ },
+ contentType = 'html'
+ )
+
+ ## EXPORT SHEPARD PLOT AS PNG ##
+ output$downloadShep <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"Shepard.png") },
+ content = function(file) {
+ shep <- getShep()
+ labcol <- getLabcol()
+ png(file=file, width = 10, height = 10, units = 'in', res = 500)
+ plot(shep, pch=19, cex=0.5, col=labcol, xlab="Distance in tree space", ylab="Distance on MDS plot")
+ dev.off()
+ },
+ contentType = 'image/png'
+ )
+
+ ## EXPORT SCREEPLOT AS PNG ##
+ output$downloadScree <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"screeplot.png") },
+ content = function(file) {
+ res <- getAnalysis()
+ labcol <- getLabcol()
+ png(file=file, width = 5, height = 3, units = 'in', res = 500)
+ barplot(res$pco$eig, col=labcol)
+ dev.off()
+ },
+ contentType = 'image/png'
+ )
+
+
+ ## EXPORT TREE PLOT AS PNG ##
+ output$downloadTree <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"SingleTree.png") },
+ content = function(file) {
+ tre <- getTree()
+ png(file=file)
+ plot(tre, type=input$treetype,
+ show.tip.lab=input$showtiplabels, font=as.numeric(input$tiplabelfont), cex=input$tiplabelsize,
+ direction=input$treedirection,
+ edge.width=input$edgewidth)
+ dev.off()
+ contentType = 'image/png'
+ }
+ )
+
+ ## EXPORT TREE COMPARISON PLOT AS PNG ##
+ output$downloadTreeDiff <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"TreeDiff.png") },
+ content = function(file) {
+ tr1 <- getTree1()
+ tr2 <- getTree2()
+ png(file=file)
+ plotTreeDiff(tr1, tr2, type=input$treetype,
+ show.tip.lab=input$showtiplabels, font=as.numeric(input$tiplabelfont), cex=input$tiplabelsize,
+ direction=input$treedirection,
+ edge.width=input$edgewidth)
+ dev.off()
+ contentType = 'image/png'
+ }
+ )
+
+ ## EXPORT TIP DIFF TABLE ##
+ output$downloadTipDiffTable <- downloadHandler(
+ filename = function() { paste0(getDataSet(),"TipDiffTable.csv")},
+ content = function(file) {
+ table <- getTipDiffTable()
+ write.csv(table, file)
+ }
+ )
+
+ ## EXPORT DENSITREE PLOT AS PNG ##
+ output$downloadDensiTree <- downloadHandler(
+ filename = function() { paste(getDataSet(), 'DensiTreeCluster',input$selectedDensiTree,'.png', sep='') },
+ content = function(file) {
+ clustTrees <- getDensiTree()
+ png(file=file)
+ densiTree(clustTrees, col=4, alpha=input$alpha, scaleX=input$scaleX)
+ dev.off()
+ contentType = 'image/png'
+ }
+ )
+
+ output$selectedGenTree <- renderUI({
+ numTrees <- getLengthData()
+ treeNames <- getTreeNames()
+ choices <- c("",1:numTrees)
+ names(choices) <- c("Choose one",treeNames)
+ selectInput("selectedGenTree", "Choose individual tree",
+ choices=choices, selected="")
+ })
+
+ output$selectedGenTree1 <- renderUI({
+ numTrees <- getLengthData()
+ treeNames <- getTreeNames()
+ choices <- c("",1:numTrees)
+ names(choices) <- c("Choose one",treeNames)
+ selectInput("selectedGenTree1", "Choose individual tree",
+ choices=choices, selected="")
+ })
+
+ output$selectedGenTree2 <- renderUI({
+ numTrees <- getLengthData()
+ treeNames <- getTreeNames()
+ choices <- c("",1:numTrees)
+ names(choices) <- c("Choose one",treeNames)
+ selectInput("selectedGenTree2", "Choose individual tree",
+ choices=choices, selected="")
+ })
+
+ output$selectedRefTree <- renderUI({
+ numTrees <- getLengthData()
+ treeNames <- getTreeNames()
+ choices <- c("",1:numTrees)
+ names(choices) <- c("Choose one",treeNames)
+ selectInput("selectedRefTree", "Select a reference tree",
+ choices=choices, selected="")
+ })
+
+
+ ## RENDER SYSTEM INFO ##
+ output$systeminfo <- .render.server.info()
+
+}) # end shinyServer
diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R
new file mode 100644
index 0000000..6a70c38
--- /dev/null
+++ b/inst/shiny/ui.R
@@ -0,0 +1,677 @@
+options(rgl.useNULL=TRUE)
+## CHECKS ##
+require("scatterD3")
+require("shiny")
+require("rgl")
+require("RLumShiny")
+require("shinyBS")
+
+## DEFINE UI ##
+shinyUI(
+ navbarPage("",position="fixed-top", collapsible = TRUE,
+ theme = "bootstrap.simplex.css",
+
+ tabPanel("Tree landscape explorer",
+ tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css'),
+ tags$style(type="text/css", "body {padding-top: 40px;}"),
+ pageWithSidebar(
+ ## TITLE ##
+ headerPanel(
+ img(src="img/logo.png", height="160")
+ ),
+
+ ## SIDE PANEL CONTENT ##
+ sidebarPanel(
+ tags$head(tags$style(
+ type = 'text/css',
+ 'form.well { max-height: 1600px; overflow-y: auto; }'
+ )),
+
+ ## SPECIFIC TO TREE LANDSCAPE EXPLORER ##
+ conditionalPanel(condition = "$('li.active a').first().html()== 'Tree landscape explorer'",
+ ## INPUT
+ ## choice of type of data source
+ img(src="img/line.png", width="100%"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Input </font>')),
+ radioButtons("datatype", HTML('<font size="4"> Choose data source:</font>'),
+ list("Example: Dengue fever"="exDengue",
+ "Example: Woodmice"="exWoodmice",
+ "Input file"="file")),
+
+ ## choice of dataset if source is a file
+ conditionalPanel(condition = "input.datatype=='file'",
+ fileInput("datafile", p(HTML(' <font size="4"> Choose input file:</font>'), br(),
+ strong("accepted formats:"), br(),
+ em("- multiphylo"), "saved from R (.RData/.rda/.rds)", br(),
+ em("- nexus"), "file (.nex/.nexus)")
+ ),
+ checkboxInput("randSamp","Randomly sample from the trees?", value=TRUE),
+ bsTooltip("randSamp", "For large sets of trees and/or trees with many tips the app may be slow, so beginning the analysis with a small random sample is recommended.",
+ placement = "right", trigger = "hover", options = NULL),
+ conditionalPanel(
+ condition="input.randSamp",
+ sliderInput("sampleSize", "Size of random sample:", value=10, min=10, max=300, step=10)
+ )
+ ),
+
+
+ ## ANALYSIS
+ img(src="img/line.png", width="100%"),
+ h4(HTML('<font color="#6C6CC4" size="6"> > Analysis </font>')),
+
+ ## choose metric
+ selectInput("treemethod", "Choose a tree summary:",
+ choices=c(
+ "Kendall Colijn (rooted)" = "metric",
+ "Billera, Holmes, Vogtmann (rooted, uses branch lengths)" = "BHV",
+ "Kuhner & Felsenstein branch score distance (unrooted, uses branch lengths)" = "KF",
+ "Robinson Foulds symmetric difference (unrooted, topological)" = "RF",
+ "Weighted Robinson Foulds (unrooted, uses branch lengths)" = "wRF",
+ "Steel & Penny tip-tip distance (unrooted, topological)" = "nNodes",
+ "Steel & Penny weighted tip-tip distance (unrooted, uses branch lengths)" = "patristic",
+ "Abouheif test (rooted, topological)" = "Abouheif",
+ "Sum of direct descendents (rooted, topological)" = "sumDD")),
+
+ ## lambda, axes
+ uiOutput("lambda"),
+ bsTooltip("lambda","When lambda=0 trees are compared topologically; increasing lambda gives more focus to branch lengths"),
+
+ conditionalPanel(
+ condition="input.plotType==1",
+ uiOutput("naxes")
+
+ ## Future: highlight median trees (if plotType==1)
+ #checkboxInput("showMedians", label=strong("Highlight median tree(s)?"), value=FALSE)
+ ),
+
+ ## show Shepard plot?
+ checkboxInput("quality", label=strong("Assess quality of projection (Shepard plot)?"), value=FALSE),
+ bsTooltip("quality","A Shepard plot gives an indication of the quality of the MDS projection. It will be displayed below the main plot.", placement="right"),
+
+ ## show screeplot?
+ conditionalPanel(
+ condition="input.graphics==1",
+ checkboxInput("scree", label=strong("Show screeplot?"), value=FALSE),
+ bsTooltip("scree","Display screeplot of the eigenvalues associated with each componenet? It will be displayed below the main plot.", placement="right")
+ ),
+
+ ## find clusters?
+ checkboxInput("findClusters", label=strong("Identify clusters?"), value=FALSE),
+ bsTooltip("findClusters","Statistical tools for choosing an appropriate clustering method and number of clusters will be added to treespace soon.", placement="right"),
+
+ conditionalPanel(condition ="input.findClusters",
+ radioButtons("clusterType", label="Method:",
+ choices=c("statistically"="stat","by metadata"="meta"), selected="stat"),
+ conditionalPanel(
+ condition="input.clusterType=='stat'",
+
+ ## clustering method
+ selectInput("clustmethod", "Clustering method:",
+ choices=c(
+ "Ward" = "ward.D2",
+ "Single" = "single",
+ "Complete" = "complete",
+ "UPGMA" = "average")),
+
+ ## number of clusters
+ uiOutput("nclust")
+ ),
+ conditionalPanel(
+ condition="input.clusterType=='meta'",
+ fileInput("metadatafile", p(HTML(' <font size="4"> Choose input file:</font>'), br(),
+ strong("accepted formats:"), br(),
+ em("- object of class factor/numeric/character/list"), "saved from R (.RData/.rda)", br(),
+ em("- csv file"), "(.csv) (first column will be used)")
+ )
+ )
+
+
+ ),
+
+
+
+
+ ## relevant if method = KC metric, allow tip emphasis
+ conditionalPanel(
+ condition="input.treemethod=='metric'",
+ ## Emphasise tips
+ checkboxInput("emphTips", label=strong("Emphasise tips?"), value=FALSE),
+ bsTooltip("emphTips","Choose tips to emphasise or de-emphasise: the vector elements corresponding to these tips are multiplied by the weight chosen below.", placement="right"),
+ ## if tip emphasis is chosen, provide options:
+ conditionalPanel(
+ condition="input.emphTips",
+
+ uiOutput("whichTips"),
+
+ sliderInput("emphWeight", "Weight of emphasis", value=2,min=0.1,max=100)
+ )
+ ),
+
+ ## AESTHETICS
+ img(src="img/line.png", width="100%"),
+
+ h2(HTML('<font color="#6C6CC4" size="6"> > Aesthetics </font>')),
+
+ ## tree landscape or compare to single reference tree
+ conditionalPanel(
+ condition="input.plot3D==2",
+ radioButtons("plotType", "View",
+ choices=c("Full tree landscape"=1,"Distances from a reference tree"=2),
+ selected=1),
+ bsTooltip("plotType", "Choose whether to view the relative distances between all trees, or a 1-dimensional plot of their distances from a fixed reference tree")
+ ),
+
+
+ ## Dimensions (3D possible if 3 or more axes retained, and full tree landscape)
+ conditionalPanel(condition="input.naxes>2",
+ conditionalPanel(
+ condition="input.plotType==1",
+ radioButtons("plot3D", "Plot dimensions",
+ choices=c("2D"=2,"3D"=3),
+ selected=2)
+ )
+ ),
+
+ conditionalPanel(
+ condition="(input.plot3D==2)&&(input.plotType==1)",
+ radioButtons("graphics", "Display using",
+ choices=c("plotGrovesD3"=1,"plotGroves"=2),
+ selected=1),
+ bsTooltip("graphics", "Choose whether to view the tree landscape using plotGrovesD3 which uses scatterD3 (interactive html) or plotGroves which uses adegraphics")
+ ),
+
+ # if plotType=1, pick the axes to view:
+ conditionalPanel(
+ condition="input.plotType==1",
+ ## select first axis to plot
+ numericInput("xax", "Indicate the x axis", value=1, min=1, max=3),
+
+ ## select second axis to plot
+ numericInput("yax", "Indicate the y axis", value=2, min=1, max=3),
+ bsTooltip("yax", "If multiple MDS axes have been retained, any combination of axes can be viewed"),
+
+ ## if in 3D, need a z axis:
+ conditionalPanel(condition="input.plot3D==3",
+ numericInput("zax", "Indicate the z axis", value=3, min=1, max=3)
+ )
+ ),
+
+ ## aesthetics for tree landscape view
+ conditionalPanel(
+ condition="input.plotType==1",
+ conditionalPanel(
+ condition="(input.plot3D==2)&&(input.graphics==1)",
+
+ ## Animate transitions?
+ checkboxInput("transitions", label="Animate transitions?", value=TRUE)
+ ),
+
+ conditionalPanel(
+ condition="(input.plot3D==2)&&(input.graphics==2)",
+
+ ## convex hulls or ellipses when clusters identified
+ conditionalPanel(
+ condition="input.findClusters",
+ radioButtons("scattertype", "Type of scatterplot",
+ choices=c("chull","ellipse"),
+ selected="chull")
+ ),
+
+ selectInput("screemds", "Position of the MDS screeplot:",
+ choices=c("None" = "none",
+ "Bottom right" = "bottomright",
+ "Bottom left" = "bottomleft",
+ "Top right" = "topright",
+ "Top left" = "topleft"),
+ selected="bottomleft")
+ ),
+
+ ## symbol size
+ sliderInput("pointsize", "Size of the points", value=2, min=0, max=10, step=0.2),
+
+ conditionalPanel(
+ condition="(input.plot3D==2)&&(input.graphics==1)",
+ ## symbol size
+ sliderInput("pointopacity", "Opacity of the points", value=0.6, min=0, max=1, step=0.05)
+ ),
+
+ conditionalPanel(
+ condition="input.plot3D==2",
+ ## display labels
+ checkboxInput("showlabels", label="Display tree labels?", value=FALSE),
+
+ conditionalPanel(
+ condition="input.showlabels",
+ ## label size
+ sliderInput("labelsize", "Size of the labels", value=1, min=0, max=10, step=1),
+
+ conditionalPanel(
+ condition="input.graphics==2",
+ checkboxInput("optimlabels", label="Optimize label position?", value=FALSE)
+ )
+ )
+ )
+
+ ),
+
+
+
+
+ # if plotType=2, option to stretch
+ conditionalPanel(
+ condition="input.plotType==2",
+
+ uiOutput("selectedRefTree"),
+
+ sliderInput("stretch", "Height of plot (pixels)", value=1600, min=800, max=12800, step=200)
+
+ ),
+
+
+ ## choose color palette (if clusters detected)
+ conditionalPanel(
+ ## condition
+ condition="input.findClusters",
+
+ selectInput("palette", "Palette for the clusters",
+ choices=c("funky", "spectral",
+ "seasun", "lightseasun", "deepseasun",
+ "rainbow", "azur", "wasp"),
+ selected="funky")
+ ),
+
+ conditionalPanel(
+ condition="input.plotType==1",
+
+ ## choose label colors
+ jscolorInput("labcol", "Label / point color", value="#1B2266", close=TRUE)
+
+ ),
+
+
+
+
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ width=4)), # end conditional panel and sidebarPanel; width is out of 12
+ ## MAIN PANEL
+ mainPanel("",
+
+ # TITLE #
+ h2(HTML('<font color="#6C6CC4" size="6"> Tree landscape explorer </font>')),
+ br(),br(),
+
+ ## function I was using for testing:
+ #verbatimTextOutput("plot_click"),
+
+ # Removed:
+ #verbatimTextOutput("caption"),
+
+ conditionalPanel(
+ condition="input.plot3D==2",
+ uiOutput("treespacePlot")
+ ),
+ conditionalPanel(
+ condition="input.plot3D==3",
+ rglwidgetOutput("treespacePlot3D", width="800px")
+ ),
+
+ conditionalPanel(
+ condition="(input.plotType==1)&&(input.plot3D==2)&&(input.graphics==1)",
+ tags$p(actionButton("scatterD3-reset-zoom", HTML("<span class='glyphicon glyphicon-search' aria-hidden='true'></span> Reset Zoom")))
+ ),
+
+ conditionalPanel(
+ condition="input.quality",
+ uiOutput("shep")
+ ),
+
+ conditionalPanel(
+ condition="(input.scree)&&(input.graphics==1)",
+ uiOutput("scree")
+ ),
+
+ br(), br(),
+
+ ## OUTPUT (save)
+ img(src="img/line.png", width="400px"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Output </font>')),
+
+ ## save MDS plot
+ conditionalPanel(
+ condition="(input.plotType==1)&&(input.plot3D==2)&&(input.graphics==1)",
+ tags$p(tags$a(id = "scatterD3-svg-export", href = "#",
+ class = "btn btn-default", HTML("<span class='glyphicon glyphicon-save' aria-hidden='true'></span> Save treespace plot as svg"))),
+ downloadButton("downloadMDS2Dhtml", "Save treespace plot as interactive html")
+ ),
+
+ conditionalPanel(
+ condition="(input.plotType==1)&&(input.plot3D==2)&&(input.graphics==2)",
+ downloadButton("downloadMDS", "Save treespace image as png file")
+ ),
+
+ conditionalPanel(
+ condition="input.plot3D==3",
+ downloadButton("downloadMDS3Dhtml", "Save treespace 3D plot as interactive html")
+ ),
+
+ conditionalPanel(
+ condition="input.quality",
+ downloadButton("downloadShep", "Save Shepard plot as png file")
+ ),
+
+ conditionalPanel(
+ condition="input.scree",
+ downloadButton("downloadScree", "Save screeplot as png file")
+ ),
+
+ ## save trees to nexus file
+ downloadButton('exporttrees', "Save trees to nexus file"),
+
+ ## save results to csv
+ downloadButton('exportrestocsv', "Save results (MDS+clusters) to csv file"),
+
+ ## save results to RData
+ downloadButton('exportrestordata', "Save results (MDS+clusters) to R object")
+ ) # end mainPanel
+ ) # end page with sidebar
+ ), # end tabPanel
+ tabPanel("Tree viewer",
+ tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css'),
+ tags$style(type="text/css", "body {padding-top: 40px;}"),
+ pageWithSidebar(
+ ## TITLE ##
+ headerPanel(
+ img(src="img/logo.png", height="160")
+ ),
+
+ ## SIDE PANEL CONTENT ##
+ sidebarPanel(
+ tags$head(tags$style(
+ type = 'text/css',
+ 'form.well { max-height: 1600px; overflow-y: auto; }'
+ )),
+
+ ## INPUT
+ ## choice of tree type
+ img(src="img/line.png", width="100%"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Input </font>')),
+
+ h2(HTML('<font color="#6C6CC4" size="4"> >> Tree view </font>')),
+
+ radioButtons("treePlotType", "View",
+ choices=c("Single tree"=1,"Two tree comparison"=2),
+ selected=1, width="100%"),
+ bsTooltip("treePlotType", "Choose whether to view a single tree or two trees side by side with their differences highlighted."),
+
+ h2(HTML('<font color="#6C6CC4" size="4"> >> Tree selection </font>')),
+
+ conditionalPanel(condition = "input.treePlotType==1",
+ radioButtons("treeChoice", "Selection",
+ choices=c("Median tree"="med","General tree selection"="gen"),
+ selected="med", width="100%"),
+ bsTooltip("treeChoice", "A geometric median tree is plotted by default. If clusters have been identified, the median for each can be viewed. Alternatively, any individual tree can be plotted."),
+
+ conditionalPanel(condition = "input.treeChoice=='med'",
+ selectInput("selectedMedTree", "Median tree from:",
+ choices=c("All trees"="all"))
+ ),
+
+ conditionalPanel(condition = "input.treeChoice=='gen'",
+ uiOutput("selectedGenTree")
+ )
+ ), # end single tree choice
+
+ conditionalPanel(condition = "input.treePlotType==2",
+ radioButtons("treeChoice1", "Select first tree",
+ choices=c("Median tree"="med","General tree selection"="gen"),
+ selected="med", width="100%"),
+ bsTooltip("treeChoice1", "Plot a geometric median tree or any individual tree"),
+
+ conditionalPanel(condition = "input.treeChoice1=='med'",
+ selectInput("selectedMedTree1", "Median tree from:",
+ choices=c("All trees"="all"))
+ ),
+
+ conditionalPanel(condition = "input.treeChoice1=='gen'",
+ uiOutput("selectedGenTree1")
+ ),
+
+ radioButtons("treeChoice2", "Select second tree",
+ choices=c("Median tree"="med","General tree selection"="gen"),
+ selected="med", width="100%"),
+ bsTooltip("treeChoice2", "Plot a geometric median tree or any individual tree"),
+
+ conditionalPanel(condition = "input.treeChoice2=='med'",
+ selectInput("selectedMedTree2", "Median tree from:",
+ choices=c("All trees"="all"))
+ ),
+
+ conditionalPanel(condition = "input.treeChoice2=='gen'",
+ uiOutput("selectedGenTree2")
+ ),
+
+ checkboxInput("showTipDiffTable", label="Display table of tip differences?", value=FALSE)
+
+ ), # end tree comparison choices
+
+
+ ## TREE AESTHETICS
+ img(src="img/line.png", width="100%"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Aesthetics </font>')),
+
+ ## condition on tree being displayed
+ conditionalPanel(condition = "input.selectedTree!=''",
+ ## use edge lengths?
+ checkboxInput("edgelengths", label="Use original branch lengths?", value=TRUE),
+
+ ## ladderize
+ checkboxInput("ladderize", label="Ladderize the tree(s)?", value=TRUE),
+
+ ## type of tree
+ radioButtons("treetype", "Type of tree",
+ choices=c("phylogram","cladogram", "fan", "unrooted", "radial"),
+ selected="phylogram", width="100%"),
+
+ ## tree direction
+ radioButtons("treedirection", "Direction of the tree",
+ choices=c("rightwards", "leftwards", "upwards", "downwards"),
+ selected="rightwards", width="100%"),
+
+ ## tip labels
+ checkboxInput("showtiplabels", label="Display tip labels?", value=TRUE),
+
+ conditionalPanel(condition="input.showtiplabels",
+ ## tip label font
+ selectInput("tiplabelfont", "Tip label font",
+ choices=c("Plain"=1,"Bold"=2,"Italic"=3,"Bold italic"=4), selected=1),
+
+ ## tip label size
+ sliderInput("tiplabelsize", "Size of the tip labels", value=1, min=0, max=5, step=0.1),
+
+ conditionalPanel(condition="input.treePlotType==1",
+ ## tip label colour
+ jscolorInput("tiplabelcolour", "Tip label colour", value="#000000", close=TRUE)
+ ),
+
+ conditionalPanel(condition="input.treePlotType==2",
+
+ selectInput("colourMethod", "Colouring method",
+ choices=c("Gradual colour ramp"=1,"Palette from adegenet"=2),
+ selected=1),
+
+ ## basic tip label colour
+ jscolorInput("basetiplabelcolour", "Label colour for tips with same ancestry", value="#BEBEBE", close=TRUE),
+
+ conditionalPanel(condition="input.colourMethod==1",
+ ## basic tip label colour
+ jscolorInput("minortiplabelcolour", "Label colour for tips with smaller ancestral differences", value="#FFDAB9", close=TRUE),
+
+ ## basic tip label colour
+ jscolorInput("majortiplabelcolour", "Label colour for tips with greater ancestral differences", value="#EE0000", close=TRUE)
+ ),
+
+ conditionalPanel(condition="input.colourMethod==2",
+ selectInput("tipPalette", "Palette",
+ choices=c("funky"=1, "spectral"=2,
+ "seasun"=3, "lightseasun"=4, "deepseasun"=5,
+ "rainbow"=6, "azur"=7, "wasp"=8),
+ selected=2)
+
+ )
+
+
+ )
+
+
+ ),
+
+
+ ## edge width
+ sliderInput("edgewidth", "Width of the edges", value=2, min=1, max=20, step=0.2),
+
+ ## edge colour
+ jscolorInput("edgecolor", "Edge colour", value="#000000", close=TRUE),
+
+
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ width=4)), # end conditional panel and sidebarPanel; width is out of 12
+
+ ## MAIN PANEL
+ mainPanel("",
+ # TITLE #
+ h2(HTML('<font color="#6C6CC4" size="6"> Tree viewer </font>')),
+ br(),br(),
+
+ ## conditional panel: plot single tree if needed
+ conditionalPanel(condition = "(input.treePlotType==1)&&(input.selectedTree!='')",
+ plotOutput("tree", height = "800px"),
+
+ br(), br(),
+
+ ## OUTPUT (save)
+ img(src="img/line.png", width="400px"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Output </font>')),
+ downloadButton("downloadTree", "Save tree image"),
+
+ br(), br()
+ ), # end single tree conditional panel
+
+ ## conditional panel: plot tree comparison if needed
+ conditionalPanel(condition = "(input.treePlotType==2)&&(input.selectedTree1!='')&&(input.selectedTree2!='')",
+ plotOutput("treeDiff", height = "800px"),
+
+ # conditional panel: show tip differences table:
+ conditionalPanel(condition = "input.showTipDiffTable",
+ tableOutput("tipDiffTable")
+ ),
+
+ br(), br(),
+
+ ## OUTPUT (save)
+ img(src="img/line.png", width="400px"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Output </font>')),
+ downloadButton("downloadTreeDiff", "Save tree comparison image"),
+
+ # conditional panel: show tip differences table:
+ conditionalPanel(condition = "input.showTipDiffTable",
+ downloadButton("downloadTipDiffTable", "Save tip differences table")
+ ),
+
+
+ br(), br()
+ ), # end tree comparison conditional panel
+
+ ## Repeat of treespace plot, for reference
+ img(src="img/line.png", width="400px"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Copy of scatter plot </font>')),
+
+ br(), br(),
+
+ uiOutput("treespacePlotTreeTab")
+
+ ) # end mainPanel
+ ) # end page with sidebar
+ ), # end tabPanel "Tree Viewer"
+ tabPanel("densiTree viewer",
+ tags$link(rel = 'stylesheet', type = 'text/css', href = 'styles.css'),
+ tags$style(type="text/css", "body {padding-top: 40px;}"),
+ pageWithSidebar(
+ ## TITLE ##
+ headerPanel(
+ img(src="img/logo.png", height="160")
+ ),
+
+ ## SIDE PANEL CONTENT ##
+ sidebarPanel(
+ tags$head(tags$style(
+ type = 'text/css',
+ 'form.well { max-height: 1600px; overflow-y: auto; }'
+ )),
+
+ ## INPUT
+ ## choice of tree type
+ img(src="img/line.png", width="100%"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Input </font>')),
+
+ ## add densiTree selector (gets updated to number of clusters by )
+ selectInput("selectedDensiTree", "Choose collection of trees to view in densiTree plot",
+ choices=c("Choose one"="","All trees"="all"), width="100%"),
+ #h2(HTML('<font color="#6C6CC4" size="2"> Note: this can be slow for large sets of trees </font>')),
+
+ bsTooltip("selectedDensiTree", "View all trees together in a densiTree plot. If clusters have been identified, the set of trees from a single cluster can be plotted. Note this function can be slow if many trees are included.", placement="bottom"),
+
+
+ ## DENSITREE AESTHETICS
+ img(src="img/line.png", width="100%"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Aesthetics </font>')),
+
+ conditionalPanel(condition = "input.selectedDensiTree!=''",
+
+ ## alpha (semitransparency of edges)
+ sliderInput("alpha", "Transparency of edges", value=0.5, min=0, max=1, step=0.05),
+
+
+ checkboxInput("scaleX", label="Scale trees to equal heights?", value=FALSE),
+
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ br(),br(),br(),br(),br(),br(),br(), # add some blank space at the end of side panel
+ width=4)), # end conditional panel and sidebarPanel; width is out of 12
+
+ ## MAIN PANEL
+ mainPanel("",
+
+ # TITLE #
+ h2(HTML('<font color="#6C6CC4" size="6"> densiTree viewer </font>')),
+ br(),br(),
+
+ ## conditional panel: plot tree if needed
+ conditionalPanel(condition = "input.selectedDensiTree!=''",
+
+ plotOutput("densiTree", height = "800px"),
+
+ br(), br(),
+
+ ## OUTPUT (save)
+ img(src="img/line.png", width="400px"),
+ h2(HTML('<font color="#6C6CC4" size="6"> > Output </font>')),
+ downloadButton("downloadDensiTree", "Save densiTree image"),
+
+ br(), br(), br(), br(), br(), br()
+ ) # end densiTree conditional panel
+ ) # end of main panel "Multi-tree viewer"
+ ) # end of page with sidebar
+ ),# end of tabPanel "densiTree viewer"
+ ## HELP SECTION
+ tabPanel("Help",
+ tags$style(type="text/css", "body {padding-top: 40px;}"),
+ HTML(paste(readLines("www/html/help.html"), collapse=" "))
+ ),
+
+ ## SERVER INFO ##
+ tabPanel("System info",
+ tags$style(type="text/css", "body {padding-top: 40px;}"),
+ verbatimTextOutput("systeminfo"))
+ ) # end of tabsetPanel
+) # end of Shiny UI
diff --git a/inst/shiny/www/bootstrap.simplex.css b/inst/shiny/www/bootstrap.simplex.css
new file mode 100644
index 0000000..4439b67
--- /dev/null
+++ b/inst/shiny/www/bootstrap.simplex.css
@@ -0,0 +1,11 @@
+ at import url("https://fonts.googleapis.com/css?family=Open+Sans:400,700");/*!
+ * bootswatch v3.3.5
+ * Homepage: http://bootswatch.com
+ * Copyright 2012-2015 Thomas Park
+ * Licensed under MIT
+ * Based on Bootstrap
+*//*!
+ * Bootstrap v3.3.5 (http://getbootstrap.com)
+ * Copyright 2011-2015 Twitter, Inc.
+ * Licensed under MIT (https://github.com/twbs/bootstrap/blob/master/LICENSE)
+ *//*! normalize.css v3.0.3 | MIT License | github.com/necolas/normalize.css */html{font-family:sans-serif;-ms-text-size-adjust:100%;-webkit-text-size-adjust:100%}body{margin:0}article,aside,details,figcaption,figure,footer,header,hgroup,main,menu,nav,section,summary{display:block}audio,canvas,progress,video{display:inline-block;vertical-align:baseline}audio:not([controls]){display:none;height:0}[hidden],template{display:none}a{background-color:transparent}a:active,a:hover{outline:0}abbr [...]
\ No newline at end of file
diff --git a/inst/shiny/www/html/help.html b/inst/shiny/www/html/help.html
new file mode 100644
index 0000000..519ed7b
--- /dev/null
+++ b/inst/shiny/www/html/help.html
@@ -0,0 +1,207 @@
+<h1 id="top"> </h1>
+<img src="img/logo.png", height="160">
+<br>
+<font color="#6C6CC4" size="3"> [statistical exploration of landscapes of phylogenetic trees] </font>
+<br>
+<br>
+<!-- <h1> Welcome to the <font color="#6C6CC4"> <i>treescape</i> </font> server! </h1> -->
+<font color="#6C6CC4"> <i>treescape</i> </font> implements statistical tools for the exploration of
+sets of phylogenetic trees describing the evolutionary relationships between the same taxa.
+This web interface provides an easy access to the resources implemented in the package.
+
+Each tab is made of two panels: a <i>sidebar</i> used to choose inputs, analysis tools and aesthetics,
+and a main panel displaying results.
+
+<br>
+<br>
+ <h3 id="tle"> <font color="#6C6CC4"> Tree landscape explorer </font></h3>
+The <i>Tree landscape explorer</i> tab is where the whole tree space can be explored.
+Choose between a two- or three-dimensional plot to visualise the trees using Metric Multidimensional Scaling (MDS, a.k.a. Principal Coordinates Analysis, PCoA),
+which calculates the best reduced-spaced visualisation of the distances between trees.
+
+The <i>sidebar</i> contains the following sections:
+ <ul>
+ <li><font color="#6C6CC4"><a href="#tlein">Input</a></font>: to upload the set of trees to analyse </li>
+ <li><font color="#6C6CC4"><a href="#tleanalysis">Analysis</a></font>: to customize the analysis </li>
+ <li><font color="#6C6CC4"><a href="#tleaesthetics">Aesthetics</a></font>: to customize the graphics </li>
+</ul>
+
+<br>
+ <h4 id="tlein"> <font color="#6C6CC4"> Input </font></h4>
+ <font color="#6C6CC4"> <i>treescape</i> </font> takes a list of phylogenetic trees as input.
+The user can choose between data distributed with the package, or provide input files.
+Two types of input files can be used:
+ <ul>
+ <li>R objects saved using the function <font face="Courier New">save(x, file="x.RData")</font>
+ where <font face="Courier New">'x'</font> is a list of trees of the class <font face="Courier
+ New">multiphylo</font> (from the <i>ape</i> package. Accepted extensions are ".RData" and ".rda".</li>
+ <li>list of trees saved in a nexus file, e.g. using <i>ape</i>'s function <font face="Courier
+ New">write.nexus(x, file="x.nex")</font> in R.</li>
+</ul>
+
+<br>
+ <h4 id="tleanalysis"> <font color="#6C6CC4"> Analysis </font></h4>
+
+ <b><font color="#6C6CC4"> Tree summary / metric: </font></b>
+ the method to be used to measure distances between tips of the trees. Choose from:
+<ul>
+ <li> <i>Kendall Colijn</i>: the tree metric developed by Kendall & Colijn; used by default</li>
+ <li> <i>Billera, Holmes, Vogtmann</i>: the Billera, Holmes & Vogtmann tree metric (also known as the 'geodesic distance')</li>
+ <li> <i>Robinson Foulds (unrooted)</i>: the Robinson Foulds tree metric. Note that this implementation of the metric (from the package <i>phangorn</i>)
+ treats the trees as unrooted and uses the unweighted edge-count distance (Robinson Foulds 1981).</li>
+ <li> <i>Tip-tip path distance (unrooted)</i>: metric by Steel and Penny which counts the number of internal nodes on the shortest path between each pair of tips.
+Along with its weighted version (below), this is also known as the tip distance, nodal distance, patristic distance and dissimilarity measure. Trees are treated as unrooted.
+ (see <font face="Courier New">?nNodes</font> in the package <i>adephylo</i>)</li>
+ <li> <i>Tip-tip branch-length distance (unrooted)</i>: similar to the tip-tip path distance, but using the branch lengths instead of counting the edges.
+ (see <font face="Courier New">?distTips</font> in the package <i>adephylo</i>)</li>
+ <li> <i>Abouheif test</i>: the Abouheif test as presented in Pavoine et al. (2008)
+ (see <font face="Courier New">?distTips</font> in the package <i>adephylo</i>)</li>
+ <li> <i>Sum of direct descendents</i>: another test related to the Abouheif test
+ (see <font face="Courier New">?distTips</font> in the package <i>adephylo</i>)</li>
+</ul>
+
+ <b><font color="#6C6CC4"> Lambda: </font></b>
+ The value of lambda used in Kendall & Colijn's metric.
+
+ <br>
+ <b><font color="#6C6CC4"> Number of MDS axes retained : </font></b>
+ The number of principal components to retain in the Metric Multidimensional Scaling (MDS).
+
+ <br>
+ <b><font color="#6C6CC4"> Assess quality of projection (Shepard plot)? </font></b>
+ It is important to be aware of how well or otherwise the Multidimensional Scaling (MDS) plot represents the tree space.
+ Euclidean metrics lend themselves to MDS plotting, whereas other metrics and summaries may prove difficult to accurately project into a small number of dimensions.
+ A Shepard plot is a scatter plot of the actual distances in tree space (x-axis) versus the projected distances in the plot (y-axis).
+ The stronger the correlation, the better the MDS plot represents the true distances.
+
+ <br>
+ <b><font color="#6C6CC4"> Identify clusters? </font></b>
+ Whether to identify clusters by different colours in the plot. Clusters may be found statistically using the <font face="Courier New"> findGroves </font> function, which attempts to group trees into clusters of nearby trees in the space.
+ When this option is selected, you will also have the option to choose the clustering method and number of clusters.
+ Alternatively, trees may be coloured by metadata. For example, if the trees were inferred from different genes, or using different inference software, then this can be shown on the plot.
+ Upload a .RData or .csv file containing a list or vector corresponding to the trees.
+ For example, if the trees were inferred from three different genes and there are 100 replicates per gene, create a character vector corresponding (in the same order) to the trees, e.g.
+ <br>
+ <font face="Courier New"> treeTypes <- c(rep("Gene1",100),rep("Gene2",100),rep("Gene3",100)) </font>
+ <br>
+ save as an .RData file, and upload. The trees will be coloured according to gene, making it possible to analyse whether or not the genes contain different phylogenetic signals, according to the chosen inference method.
+
+<br> <br>
+ <h4 id="tleaesthetics"> <font color="#6C6CC4"> Aesthetics </font></h4>
+A number of graphical options are available.
+
+<br>
+ <b><font color="#6C6CC4"> View: </font></b>
+ The default is to view the entire "tree landscape", that is, a 2- or 3-dimensional map where the points correspond to trees
+ and the distances between points approximate their relative distances in tree space, according to the chosen measure.
+ The rest of the options detailed below correspond to this view.
+
+ An alternative is to pick a single "reference tree" and plot the distances from it to each other tree.
+ If this view is chosen, you will be given the option to select the reference tree of interest.
+ When there are many trees in the set, it may be helpful to expand the plot by using the scale bar to increase the height,
+ to view the tree labels more easily.
+ Finally, if clusters are identified in the analysis then these will be marked on this plot in the corresponding colours.
+ Note that this gives an indication of the quality of the clustering: highly scattered clusters correspond to poor resolution in the space.
+ Clusters can overlap in this view: it is quite possible for multiple clusters of trees to be equidistant from the reference tree
+ in different "directions" in the space.
+
+ <br>
+ <b><font color="#6C6CC4"> Plot dimensions: </font></b>
+ If three or more axes have been retained, the option to view the space in three dimensions will be available.
+ It is possible to rotate the image by clicking on it and dragging the mouse, and to zoom in and out with the mouse scroll button.
+ Note that 3D plotting depends on the <i> rglwidget </i> package. At the time of writing, the latest CRAN version (0.1.1431) contains a bug; if you are running this version then you will receive a warning recommending installing the latest development version:
+ <font face="Courier New"> install.packages('rglwidget', repos='http://R-Forge.R-project.org') </font>.
+
+ <br>
+ <b><font color="#6C6CC4"> x/y/z axes: </font></b>
+ Used to select which principal components are represented as x and y axes
+(and, if viewing in 3D, the z axis) on the scatterplot.
+
+<br><br>
+ <h4 id="tleoutput"> <font color="#6C6CC4"> Output </font></h4>
+Beneath the scatterplot are output options: the scatterplot, trees and analysis results can be exported in various formats.
+Currently available options are:
+<ul>
+ <li> save the 2D scatterplot as a png file or the 3D scatterplot as an interactive html file. Unfortunately a formal method to save a snapshot of the 3D plot is not yet supported, but you can right-click (Mac: long-click) on the image and select '<i>Save image as ...</i>'. </li>
+ <li> (if plotted) save the Shepard plot as a png file </li>
+ <li> save trees to a Nexus file (.nex) </li>
+ <li> save results as csv file (spreadsheet-like text file; compatible with most systems);
+ results are output as a table where each row is a tree label, and columns contain optional
+ clustering results as well as principal components (PC) of the Metric Multidimensional Scaling
+ (MDS) of the tree space </li>
+ <li> save results as an R object (.RData); in this case, two objects will be saved in the
+ .RData: 'trees' will be a list of trees of class 'multiPhylo', and 'analysis' will be the results
+ of the analysis; when clusters are not inferred, 'analysis' is the output of the function
+ 'treescape'; when clusters are inferred, 'analysis' is the output of the function 'findGroves'. </li>
+</ul>
+
+<br>
+ <h3 id="tv"> <font color="#6C6CC4"> Tree viewer </font></h3>
+The <i>Tree viewer</i> tab is where individual trees can be plotted, one or two at a time.
+The <i>sidebar</i> contains the following sections:
+ <ul>
+ <li><font color="#6C6CC4"><a href="#tvin">Input</a></font>: to pick the tree or trees to view </li>
+ <li><font color="#6C6CC4"><a href="#tvaesthetics">Aesthetics</a></font>: to customize the graphics </li>
+</ul>
+
+ <h4 id="tvin"> <font color="#6C6CC4"> Input </font></h4>
+The tree selection options are as follows:
+<ul>
+ <li> Single tree view: for plotting a single tree </li>
+ <li> Two tree comparison: for plotting two trees side by side, using tip colour to highlight topological differences </li>
+</ul>
+Within each of these viewing modes, the tree or trees may be selected as follows:
+<ul>
+ <li>Median tree: select the overall median tree, or, if clusters have been identified, the median from each cluster</li>
+ <li>General tree selection: select an individual tree by its name (if provided) or number in the list of trees supplied</li>
+</ul>
+
+ <h4 id="tvaesthetics"> <font color="#6C6CC4"> Aesthetics </font></h4>
+A number of graphical options are available.
+See <font face="Courier New">?plot.phylo</font> from the package <i>ape</i> for more details.
+
+<br>
+ <h4 id="tvoutput"> <font color="#6C6CC4"> Output </font></h4>
+Beneath the tree(s) is the option to save the image as a .png file.
+
+<br>
+<br>
+ <h3 id="dtv"> <font color="#6C6CC4"> densiTree viewer </font></h3>
+The <i>densiTree viewer</i> tab is where collections of trees can be viewed together using the
+<font face="Courier New">densiTree</font> function from the package <i>phangorn</i>, which is based on the
+software <a href="https://www.cs.auckland.ac.nz/~remco/DensiTree/" target="_blank">densiTree</a>, which provides
+considerably more functionality.
+
+The <i>sidebar</i> contains the following sections:
+ <ul>
+ <li><font color="#6C6CC4"><a href="#dtvin">Input</a></font>: to pick the collection of trees to view </li>
+ <li><font color="#6C6CC4"><a href="#dtvaesthetics">Aesthetics</a></font>: to customize the graphics </li>
+</ul>
+
+ <h4 id="dtvin"> <font color="#6C6CC4"> Input </font></h4>
+The entire tree set can be viewed using the option 'All trees'. Note that this is likely to be slow for large sets of trees.
+If clusters have been detected in the <i>Tree landscape explorer</i> tab then the collection of trees from each cluster can also be selected.
+This can help to show the variation within the cluster.
+
+<br>
+ <h4 id="dtvaesthetics"> <font color="#6C6CC4"> Aesthetics </font></h4>
+ A number of graphical options are available; further options will be added soon.
+
+<br>
+ <h4 id="dtvoutput"> <font color="#6C6CC4"> Output </font></h4>
+Beneath the densiTree plot is the option to save the image as a .png file.
+
+<br>
+<br>
+ <h3 id="more"> <font color="#6C6CC4"> More information </font></h3>
+ <i>treescape</i> is developed on <a href="https://github.com/thibautjombart/treescape" target="_blank">github</a>.
+For questions, bug reports, feature requests and contributions, please
+ use <a href="https://github.com/thibautjombart/treescape/issues" target="_blank">github's issue system</a>.
+
+<br>
+<br>
+<br>
+<a href="#top">[Back to top]</a>
+<br>
+<br>
+<br>
diff --git a/inst/shiny/www/img/line.png b/inst/shiny/www/img/line.png
new file mode 100644
index 0000000..1367fde
Binary files /dev/null and b/inst/shiny/www/img/line.png differ
diff --git a/inst/shiny/www/img/logo.png b/inst/shiny/www/img/logo.png
new file mode 100644
index 0000000..f77a257
Binary files /dev/null and b/inst/shiny/www/img/logo.png differ
diff --git a/inst/shiny/www/styles.css b/inst/shiny/www/styles.css
new file mode 100644
index 0000000..1188d1a
--- /dev/null
+++ b/inst/shiny/www/styles.css
@@ -0,0 +1,11 @@
+.shiny-progress {
+ top: 50% !important;
+ left: 50% !important;
+ margin-top: -100px !important;
+ margin-left: -250px !important;
+}
+
+.shiny-output-error-validation {
+ font-size: 20px;
+ color: #777777;
+ }
\ No newline at end of file
diff --git a/man/DengueBEASTMCC.Rd b/man/DengueBEASTMCC.Rd
new file mode 100644
index 0000000..b4cc7f0
--- /dev/null
+++ b/man/DengueBEASTMCC.Rd
@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{DengueBEASTMCC}
+\alias{DengueBEASTMCC}
+\title{Dengue fever BEAST MCC tree}
+\format{A phylo object}
+\source{
+http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+}
+\description{
+The maximum clade credibility (MCC) tree from \code{\link{DengueTrees}}
+}
+\references{
+Drummond, A. J., and Rambaut, A. (2007)
+BEAST: Bayesian evolutionary analysis by sampling trees.
+\emph{BMC Evolutionary Biology}, 7(1), 214.
+
+Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+Molecular evolution and phylogeny of dengue-4 viruses.
+\emph{Journal of General Virology}, 78(9), 2279-2286.
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
+\keyword{datasets}
diff --git a/man/DengueSeqs.Rd b/man/DengueSeqs.Rd
new file mode 100644
index 0000000..d06ac2a
--- /dev/null
+++ b/man/DengueSeqs.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{DengueSeqs}
+\alias{DengueSeqs}
+\title{Dengue fever sequences}
+\format{A DNAbin object containing 17 DNA sequences, each of length 1485.}
+\source{
+http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+}
+\description{
+17 dengue virus serotype 4 sequences from Lanciotti et al. (1997)
+}
+\references{
+Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+Molecular evolution and phylogeny of dengue-4 viruses.
+\emph{Journal of General Virology}, 78(9), 2279-2286.
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
+\keyword{datasets}
diff --git a/man/DengueTrees.Rd b/man/DengueTrees.Rd
new file mode 100644
index 0000000..02d01b3
--- /dev/null
+++ b/man/DengueTrees.Rd
@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{DengueTrees}
+\alias{DengueTrees}
+\title{BEAST analysis of Dengue fever}
+\format{A multiPhylo object containing 500 trees, each with 17 tips}
+\source{
+http://bmcevolbiol.biomedcentral.com/articles/10.1186/1471-2148-7-214
+}
+\description{
+These trees were created using one of the \code{xml} files provided with the original BEAST paper by Drummond and Rambaut (2007).
+They provide an example of 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997) (available as \code{\link{DengueSeqs}}) and \code{xml} files with varying priors for model and clock rate.
+Here we include a random sample of 500 of the trees (from the second half of the posterior) produced using BEAST v1.8 with the standard GTR + Gamma + I substitution model with uncorrelated lognormal-distributed relaxed molecular clock (file 4).
+}
+\references{
+Drummond, A. J., and Rambaut, A. (2007)
+BEAST: Bayesian evolutionary analysis by sampling trees.
+\emph{BMC Evolutionary Biology}, 7(1), 214.
+
+Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997)
+Molecular evolution and phylogeny of dengue-4 viruses.
+\emph{Journal of General Virology}, 78(9), 2279-2286.
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
+\keyword{datasets}
diff --git a/man/findGroves.Rd b/man/findGroves.Rd
new file mode 100644
index 0000000..314d51f
--- /dev/null
+++ b/man/findGroves.Rd
@@ -0,0 +1,59 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/findGroves.R
+\name{findGroves}
+\alias{findGroves}
+\title{Identify clusters of similar trees}
+\usage{
+findGroves(x, method = "treeVec", nf = NULL, clustering = "ward.D2",
+ nclust = NULL, ...)
+}
+\arguments{
+\item{x}{an object of the class multiPhylo or the output of the function \code{treespace}}
+
+\item{method}{(ignored if x is from \code{treespace}) this specifies a function which outputs the summary of a tree in the form of a vector. Defaults to \code{treeVec}.}
+
+\item{nf}{(ignored if x is from \code{treespace}) the number of principal components to retain}
+
+\item{clustering}{a character string indicating the clustering method to be used; defaults to Ward's method; see argument \code{method} in \code{?hclust} for more details.}
+
+\item{nclust}{an integer indicating the number of clusters to find; if not provided, an interactive process based on cutoff threshold selection is used.}
+
+\item{...}{further arguments to be passed to \code{treespace}}
+}
+\value{
+A list containing:
+\itemize{
+ \item groups: a factor defining groups of trees
+ \item treespace: the output of treespace
+}
+}
+\description{
+This function uses hierarchical clustering on principal components output by \code{\link{treespace}} to identify groups of similar trees. Clustering relies on \code{\link{hclust}}, using Ward's method by default.
+}
+\examples{
+
+if(require("adegenet") && require("adegraphics")){
+## load data
+data(woodmiceTrees)
+
+## run findGroves: treespace+clustering
+res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+
+## plot results on first 2 axes
+PCs <- res$treespace$pco$li
+s.class(PCs, fac=res$groups, col=funky(6))
+
+## using plotGroves
+plotGroves(res)
+}
+
+
+}
+\seealso{
+\code{\link{plotGroves}} to display results
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/findMRCIs.Rd b/man/findMRCIs.Rd
new file mode 100644
index 0000000..9e54e5c
--- /dev/null
+++ b/man/findMRCIs.Rd
@@ -0,0 +1,33 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/transmissionTrees.R
+\name{findMRCIs}
+\alias{findMRCIs}
+\title{Find MRCIs}
+\usage{
+findMRCIs(wiw)
+}
+\arguments{
+\item{wiw}{a two-column matrix where the first column represents the infectors and the infectees; each row corresponds to a transmission event from an infector to an infectee.}
+}
+\value{
+Returns three objects:
+\itemize{
+\item \code{sourceCase}: the number of the node which is the source case, i.e. the common infector of all cases (outputs a warning if there is more than one source case).
+\item \code{mrcis}: a matrix where, for each pair of individuals i and j, the entry (i,j) is the node number of their MRCI. Note that if i infected j then this entry is i itself.
+\item \code{mrciDepths}: a matrix where, for each pair of individuals i and j, the entry (i,j) is the depth of their MRCI, defined as the number of edges from the source case. The source case has depth zero, its direct infectees have depth 1, and so on.
+}
+}
+\description{
+Function to find the most recent common infector (MRCI) matrix from "who infected whom" information.
+}
+\examples{
+
+## a simple who infected whom matrix:
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+findMRCIs(tree1)
+
+
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/fluTrees.Rd b/man/fluTrees.Rd
new file mode 100644
index 0000000..1635a47
--- /dev/null
+++ b/man/fluTrees.Rd
@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{fluTrees}
+\alias{fluTrees}
+\title{BEAST analysis of seasonal influenza (A/H3N2)}
+\format{A multiPhylo object containing 200 trees, each with 165 tips}
+\source{
+http://beast.bio.ed.ac.uk/tutorials
+}
+\description{
+These trees were created using BEAST on hemagglutinin (HA) segments
+of seasonal influenza A/H3N2 samples collected in New-York city (US) between 2000 and 2003. This data comes from the influenza BEAST tutorial distributed at:
+http://beast.bio.ed.ac.uk/tutorials
+}
+\details{
+Only the first 200 trees (out of 10,000) were retained.
+}
+\references{
+http://beast.bio.ed.ac.uk/tutorials
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+}
+\keyword{datasets}
diff --git a/man/linearMrca.Rd b/man/linearMrca.Rd
new file mode 100644
index 0000000..6f7c033
--- /dev/null
+++ b/man/linearMrca.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metrics.R
+\name{linearMrca}
+\alias{linearMrca}
+\title{Linear MRCA function}
+\usage{
+linearMrca(tree, k = 0)
+}
+\arguments{
+\item{tree}{an object of the class \code{phylo} which should be rooted.}
+
+\item{k}{(optional) number of tips in tree, for faster computation}
+}
+\description{
+Function to make the most recent common ancestor (MRCA) matrix of a tree, where entry (i,j) gives the MRCA of tips i and j.
+The function is linear, exploiting the fact that the tree is rooted.
+}
+\examples{
+
+## generate a random tree
+x <- rtree(6)
+
+## create matrix of MRCAs: entry (i,j) is the node number of the MRCA of tips i and j
+linearMrca(x,6)
+
+
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/medTree.Rd b/man/medTree.Rd
new file mode 100644
index 0000000..40aeab9
--- /dev/null
+++ b/man/medTree.Rd
@@ -0,0 +1,86 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/medTree.R
+\name{medTree}
+\alias{medTree}
+\title{Geometric median tree function}
+\usage{
+medTree(x, groups = NULL, lambda = 0, weights = NULL,
+ emphasise.tips = NULL, emphasise.weight = 2,
+ return.lambda.function = FALSE, save.memory = FALSE)
+}
+\arguments{
+\item{x}{A list of trees of the class multiPhylo, for which the median tree will be computed, \cr
+OR a matrix of tree vectors as given by \code{treespace$vectors}.}
+
+\item{groups}{an optional factor defining groups of trees; if provided, one median tree will be found for each group.}
+
+\item{lambda}{a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE} or if the vectors are already supplied as the object \code{x}.}
+
+\item{weights}{A vector of weights for the trees. Defaults to a vector of 1's so that all trees are equally weighted, but can be used to encode likelihood, posterior probabilities or other characteristics.}
+
+\item{emphasise.tips}{an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.}
+
+\item{emphasise.weight}{applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.}
+
+\item{return.lambda.function}{If true, a function that can be invoked with different lambda values is returned.
+This function returns the vector of metric values for the given lambda. Ignored if the tree vectors are already supplied as the object \code{x}.}
+
+\item{save.memory}{A flag that saves a lot of memory but increases the execution time (not compatible with return.lambda.function=TRUE). Ignored if the tree vectors are already supplied as the object \code{x}.}
+}
+\value{
+A list of five objects:
+\itemize{
+\item $centre is the "central vector", that is, the (weighted) mean of the tree vectors (which typically does not correspond to a tree itself);
+\item $distances gives the distance of each tree from the central vector;
+\item $mindist is the minimum of these distances;
+\item $treenumbers gives the numbers (and, if supplied, names) of the "median tree(s)", that is, the tree(s) which achieve this minimum distance to the centre;
+\item $trees if trees were supplied then this returns the median trees as a multiPhylo object.
+}
+If groups are provided, then one list is returned for each group.
+If \code{return.lambda.function=TRUE} then a function is returned that produces this list for a given value of lambda.
+}
+\description{
+Finds the geometric median of a set of trees according to the Kendall Colijn metric.
+}
+\examples{
+
+## EXAMPLE WITH WOODMICE DATA
+data(woodmiceTrees)
+
+## LOOKING FOR A SINGLE MEDIAN
+## get median tree(s)
+res <- medTree(woodmiceTrees)
+res
+
+## plot first tree
+med.tree <- res$trees[[1]]
+plot(med.tree)
+
+## LOOKING FOR MEDIANS IN SEVERAL CLUSTERS
+## identify 6 clusters
+groves <- findGroves(woodmiceTrees, nf=3, nclust=6)
+
+## find median trees
+res.with.grp <- medTree(woodmiceTrees, groves$groups)
+
+## there is one output per cluster
+names(res.with.grp)
+
+## get the first median of each
+med.trees <- lapply(res.with.grp, function(e) ladderize(e$trees[[1]]))
+
+## plot trees
+par(mfrow=c(2,3))
+for(i in 1:length(med.trees)) plot(med.trees[[i]], main=paste("cluster",i))
+
+## highlight the differences between a pair of median trees
+plotTreeDiff(med.trees[[1]],med.trees[[5]])
+
+}
+\author{
+Jacob Almagro-Garcia \email{nativecoder at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+
+Thibaut Jombart \email{thibautjombart at gmail.com}
+}
diff --git a/man/multiDist.Rd b/man/multiDist.Rd
new file mode 100644
index 0000000..454d898
--- /dev/null
+++ b/man/multiDist.Rd
@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metrics.R
+\name{multiDist}
+\alias{multiDist}
+\title{Metric function for \code{multiPhylo} input}
+\usage{
+multiDist(trees, lambda = 0, return.lambda.function = FALSE,
+ save.memory = FALSE, emphasise.tips = NULL, emphasise.weight = 2)
+}
+\arguments{
+\item{trees}{an object of the class \code{multiPhylo} containing the trees to be compared}
+
+\item{lambda}{a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.}
+
+\item{return.lambda.function}{If true, a function that can be invoked with different lambda values is returned.
+This function returns the matrix of metric values for the given lambda.}
+
+\item{save.memory}{A flag that saves a lot of memory but increases the execution time (not compatible with return.lambda.function=TRUE).}
+
+\item{emphasise.tips}{an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.}
+
+\item{emphasise.weight}{applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.}
+}
+\value{
+The pairwise tree distance matrix or a function that produces the distance matrix given a value for lambda.
+}
+\description{
+Comparison of a list of trees using the Kendall Colijn metric. Output is given as a pairwise distance matrix. This is equivalent to the \code{$D} output from \code{treespace} but may be preferable for large datasets, and when principal co-ordinate analysis is not required. It includes an option to save memory at the expense of computation time.
+}
+\examples{
+
+## generate 10 random trees, each with 6 tips
+trees <- rmtree(10,6)
+
+## pairwise distance matrix when lambda=0
+multiDist(trees)
+
+## pairwise distance matrix as a function of lambda:
+m <- multiDist(trees, return.lambda.function=TRUE)
+
+## evaluate at lambda=0. Equivalent to multiDist(trees).
+m0 <- m(0)
+
+## save memory by recomputing each tree vector for each pairwise tree comparison (for fixed lambda):
+m0.5 <- multiDist(trees,0.5,save.memory=TRUE)
+
+
+}
+\author{
+Jacob Almagro-Garcia \email{nativecoder at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/plotGroves.Rd b/man/plotGroves.Rd
new file mode 100644
index 0000000..5fc9f45
--- /dev/null
+++ b/man/plotGroves.Rd
@@ -0,0 +1,97 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotGroves.R
+\name{plotGroves}
+\alias{plotGroves}
+\title{Scatterplot of groups of trees}
+\usage{
+plotGroves(x, groups = NULL, xax = 1, yax = 2, type = c("chull",
+ "ellipse"), col.pal = funky, bg = "white", lab.show = FALSE,
+ lab.col = "black", lab.cex = 1, lab.optim = TRUE, point.cex = 1,
+ scree.pal = NULL, scree.size = 0.2, scree.posi = c(0.02, 0.02), ...)
+}
+\arguments{
+\item{x}{a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}}
+
+\item{groups}{a factor defining groups of trees}
+
+\item{xax}{a number indicating which principal component to be used as 'x' axis}
+
+\item{yax}{a number indicating which principal component to be used as 'y' axis}
+
+\item{type}{a character string indicating which type of graph to use}
+
+\item{col.pal}{a color palette to be used for the groups}
+
+\item{bg}{the background color}
+
+\item{lab.show}{a logical indicating whether labels should be displayed}
+
+\item{lab.col}{a color for the labels}
+
+\item{lab.cex}{the size of the labels}
+
+\item{lab.optim}{a logical indicating whether label positions should be optimized to avoid overlap; better display but time-consuming for large datasets}
+
+\item{point.cex}{the size of the points}
+
+\item{scree.pal}{a color palette for the screeplot}
+
+\item{scree.size}{a size factor for the screeplot, between 0 and 1}
+
+\item{scree.posi}{either a character string or xy coordinates indicating the position of the screeplot.}
+
+\item{...}{further arguments passed to \code{\link{s.class}}}
+}
+\value{
+An \code{adegraphics} object (class: \code{ADEgS})
+}
+\description{
+This function displays the scatterplot of the Multidimensional
+Scaling (MDS) output by treespace, superimposing group information
+(derived by \code{\link{findGroves}}) using colors.
+}
+\details{
+This function relies on \code{\link[adegraphics]{s.class}}
+from the \code{adegraphics} package.
+}
+\examples{
+
+\dontrun{
+if(require("adegenet") && require("adegraphics")){
+## load data
+data(woodmiceTrees)
+
+## run findGroves: treespace+clustering
+res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+
+## basic plot
+plotGroves(res)
+
+## adding labels
+plotGroves(res, lab.show=TRUE)
+
+## customizing
+plotGroves(res, lab.show=TRUE,
+bg="black", lab.col="white", scree.size=.35)
+
+## customizing
+plotGroves(res, type="ellipse", lab.show=TRUE,
+lab.optim=FALSE, scree.size=.35)
+
+## example with no group information
+plotGroves(res$treespace$pco)
+
+## adding labels
+plotGroves(res$treespace$pco, lab.show=TRUE, lab.cex=2)
+
+}
+}
+
+}
+\seealso{
+\code{\link{findGroves}} to find any clusters in the tree landscape
+\code{\link[adegraphics]{s.class}}
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+}
diff --git a/man/plotGrovesD3.Rd b/man/plotGrovesD3.Rd
new file mode 100644
index 0000000..b9e8bc4
--- /dev/null
+++ b/man/plotGrovesD3.Rd
@@ -0,0 +1,69 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotGroves.R
+\name{plotGrovesD3}
+\alias{plotGrovesD3}
+\title{Scatterplot of groups of trees using \code{scatterD3}}
+\usage{
+plotGrovesD3(x, groups = NULL, xax = 1, yax = 2, treeNames = NULL,
+ symbol_var = NULL, xlab = paste0("Axis ", xax), ylab = paste0("Axis ",
+ yax), ...)
+}
+\arguments{
+\item{x}{a list returned by \code{\link{findGroves}} or a MDS with class \code{dudi}}
+
+\item{groups}{a factor defining groups of trees. If x is a list returned by \code{\link{findGroves}} these will be detected automatically.}
+
+\item{xax}{a number indicating which principal component to be used as 'x' axis}
+
+\item{yax}{a number indicating which principal component to be used as 'y' axis}
+
+\item{treeNames}{if a list of tree names or labels are given, these will be plotted alongside the points. Their size can be altered using \code{labels_size} - see \code{?scatterD3} for more information.}
+
+\item{symbol_var}{a factor by which to vary the symbols in the plot}
+
+\item{xlab}{the label for the 'x' axis. Defaults to use the value of 'xax'}
+
+\item{ylab}{the label for the 'y' axis. Defaults to use the value of 'yax'}
+
+\item{...}{further arguments passed to \code{\link{scatterD3}}}
+}
+\value{
+A \code{scatterD3} plot
+}
+\description{
+This function displays the scatterplot of the Multidimensional
+Scaling (MDS) output by treespace, superimposing group information
+(derived by \code{\link{findGroves}}) using colors.
+\code{scatterD3} enables interactive plotting based on d3.js, including zooming, panning and fading effects in the legend.
+}
+\examples{
+
+\dontrun{
+if(require("adegenet") && require("scatterD3")){
+## load data
+data(woodmiceTrees)
+
+## run findGroves: treespace+clustering
+res <- findGroves(woodmiceTrees, nf=5, nclust=6)
+
+## basic plot
+plotGrovesD3(res)
+
+## adding tree labels
+plotGrovesD3(res, treeNames=1:201)
+
+## customizing: vary the colour and the symbol by group
+plotGrovesD3(res, symbol_var=res$groups)
+
+## example with no group information
+plotGrovesD3(res$treespace$pco)
+}
+}
+
+}
+\seealso{
+\code{\link{findGroves}} to find any clusters in the tree landscape
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+}
diff --git a/man/plotTreeDiff.Rd b/man/plotTreeDiff.Rd
new file mode 100644
index 0000000..7081b44
--- /dev/null
+++ b/man/plotTreeDiff.Rd
@@ -0,0 +1,72 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotTreeDiff.R
+\name{plotTreeDiff}
+\alias{plotTreeDiff}
+\title{Plot tree differences}
+\usage{
+plotTreeDiff(tr1, tr2, tipDiff = NULL, vec1 = NULL, vec2 = NULL,
+ baseCol = "grey", col1 = "peachpuff", col2 = "red2",
+ colourMethod = "ramp", palette = lightseasun, ...)
+}
+\arguments{
+\item{tr1}{an object of the class \code{phylo}: the first tree to plot.}
+
+\item{tr2}{an object of the class \code{phylo}: the second tree to plot.}
+
+\item{tipDiff}{an optional input, the result of \code{\link{tipDiff}}. Supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.}
+
+\item{vec1}{an optional input, the result of \code{treeVec(tr1, lambda=0)}. This argument is ignored if \code{tipDiff} is supplied; otherwise supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.}
+
+\item{vec2}{an optional input, the result of \code{treeVec(tr2, lambda=0)}. This argument is ignored if \code{tipDiff} is supplied; otherwise supplying this will save time if calling \code{plotTreeDiff} repeatedly, for example with different aesthetics.}
+
+\item{baseCol}{the colour used for tips with identical ancestry in the two trees. Defaults to "grey".}
+
+\item{col1}{the first colour used to define the colour spectrum for tips with differences. This colour will be used for tips with minor differences. Defaults to "peachpuff". Ignored if \code{colourMethod="palette"}.}
+
+\item{col2}{the second colour used to define the colour spectrum for tips with differences. This colour will be used for tips with major differences. Defaults to "red2". Ignored if \code{colourMethod="palette"}.}
+
+\item{colourMethod}{the method to use for colouring. Default is "ramp", corresponding to the original implementation, where the function \code{colorRampPalette} is used to create a palette which ranges from \code{col1} to \code{col2}. For large trees this can be hard to interpret, and method \code{palette} may be preferred, which permits the selection of a palette to use in \code{adegenet}'s function \code{num2col}.}
+
+\item{palette}{the colour palette to be used if \code{colourMethod="palette"}. For a list of available palettes see \code{?num2col}.}
+
+\item{...}{further arguments passed to \code{\link{plot.phylo}}}
+}
+\value{
+A plot of the two trees side by side. Tips are coloured in the following way:
+\itemize{
+\item if each ancestor of a tip in tree 1 occurs in tree 2 with the same partition of tip descendants, then the tip is coloured grey (or supplied "baseCol")
+\item if not, the tip gets coloured pale orange to red on a scale according to how many differences there are amongst its most recent common ancestors with other tips. The colour spectrum can be changed according to preference.
+}
+}
+\description{
+Highlight the topologicial differences between two trees, plotted side by side.
+This function is useful for comparing representative "median" trees - see \code{\link{medTree}}.
+It relies on the function \code{\link{tipDiff}}.
+}
+\examples{
+## simple example on trees with five tips:
+tr1 <- read.tree(text="((A:1,B:1):1,((C:1,D:1):1,E:1):1):1;")
+tr2 <- read.tree(text="((A:1,B:1):1,(C:1,(D:1,E:1):1):1):1;")
+plotTreeDiff(tr1,tr2)
+
+## example on larger woodmice trees
+data(woodmiceTrees)
+# find the tip differences in advance, to avoid recalculating with each plot
+wmTipDiff <- tipDiff(woodmiceTrees[[1]],woodmiceTrees[[2]])
+plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff)
+## change aesthetics:
+plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff,
+ baseCol="grey2", col1="cyan", col2="navy",
+ edge.width=2, type="radial", cex=0.5, font=2)
+## use colour palette from adegenet:
+plotTreeDiff(woodmiceTrees[[1]],woodmiceTrees[[2]], tipDiff=wmTipDiff,
+ baseCol="black", colourMethod="palette",
+ edge.width=2, type="cladogram", cex=0.5, font=2)
+
+}
+\seealso{
+\code{\link{medTree}}, \code{\link{tipDiff}}
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/refTreeDist.Rd b/man/refTreeDist.Rd
new file mode 100644
index 0000000..a5bb4e1
--- /dev/null
+++ b/man/refTreeDist.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metrics.R
+\name{refTreeDist}
+\alias{refTreeDist}
+\title{Metric function for comparing a reference \code{phylo} to \code{multiPhylo} input}
+\usage{
+refTreeDist(refTree, trees, lambda = 0, return.lambda.function = FALSE,
+ emphasise.tips = NULL, emphasise.weight = 2)
+}
+\arguments{
+\item{refTree}{a tree of class \code{phylo}, the "reference tree".}
+
+\item{trees}{an object of the class \code{multiPhylo} containing the trees to be compared to the reference tree}
+
+\item{lambda}{a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.}
+
+\item{return.lambda.function}{If true, a function that can be invoked with different lambda values is returned.
+This function returns the vector of metric values for the given lambda.}
+
+\item{emphasise.tips}{an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.}
+
+\item{emphasise.weight}{applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.}
+}
+\value{
+The vector of distances, where entry i corresponds to the distance between the i'th tree and the reference tree, or a function that produces the vector of distances given a value for lambda.
+}
+\description{
+Comparison of a single reference tree to a list of trees using the Kendall Colijn metric. Output is given as a vector of distances from the reference tree.
+}
+\examples{
+
+## generate a single reference tree with 6 tips
+refTree <- rtree(6)
+
+## generate 10 random trees, each with 6 tips
+trees <- rmtree(10,6)
+
+## find the distances from each of the 10 random trees to the single reference tree
+refTreeDist(refTree,trees)
+
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/tipDiff.Rd b/man/tipDiff.Rd
new file mode 100644
index 0000000..2eef4d9
--- /dev/null
+++ b/man/tipDiff.Rd
@@ -0,0 +1,42 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotTreeDiff.R
+\name{tipDiff}
+\alias{tipDiff}
+\title{Find tip position differences}
+\usage{
+tipDiff(tr1, tr2, vec1 = NULL, vec2 = NULL)
+}
+\arguments{
+\item{tr1}{an object of the class \code{phylo}: the first tree to compare.}
+
+\item{tr2}{an object of the class \code{phylo}: the second tree to compare.}
+
+\item{vec1}{an optional input, the result of \code{treeVec(tr1, lambda=0)}, to speed up the computation.}
+
+\item{vec2}{an optional input, the result of \code{treeVec(tr2, lambda=0)}, to speed up the computation.}
+}
+\value{
+A data frame of the tree tips and the number of ancestral differences between them in the two trees, in order of increasing difference.
+A tip is said to have zero difference if each of its ancestral nodes admits the same tip partition in the two trees.
+}
+\description{
+Find the topologicial differences between two trees with the same tip labels. The function returns a data frame of the tips and the number of differences in their ancestry between the two trees.
+Called by \code{\link{plotTreeDiff}}, which highlights the differing tips in a plot of the two trees.
+}
+\examples{
+## simple example on trees with five tips:
+tr1 <- read.tree(text="((A:1,B:1):1,((C:1,D:1):1,E:1):1):1;")
+tr2 <- read.tree(text="((A:1,B:1):1,(C:1,(D:1,E:1):1):1):1;")
+tipDiff(tr1,tr2)
+
+## example on larger woodmice trees
+data(woodmiceTrees)
+tipDiff(woodmiceTrees[[1]],woodmiceTrees[[2]])
+
+}
+\seealso{
+\code{\link{medTree}} \code{\link{plotTreeDiff}}
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/treeDist.Rd b/man/treeDist.Rd
new file mode 100644
index 0000000..f6d4971
--- /dev/null
+++ b/man/treeDist.Rd
@@ -0,0 +1,52 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metrics.R
+\name{treeDist}
+\alias{treeDist}
+\title{Metric function}
+\usage{
+treeDist(tree.a, tree.b, lambda = 0, return.lambda.function = FALSE,
+ emphasise.tips = NULL, emphasise.weight = 2)
+}
+\arguments{
+\item{tree.a}{an object of the class \code{phylo}}
+
+\item{tree.b}{an object of the class \code{phylo} (with the same tip labels as tree.a)}
+
+\item{lambda}{a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.}
+
+\item{return.lambda.function}{If true, a function that can be invoked with different lambda values is returned.
+This function returns the vector of metric values for the given lambda.}
+
+\item{emphasise.tips}{an optional list of tips whose entries in the tree vectors should be emphasised. Defaults to \code{NULL}.}
+
+\item{emphasise.weight}{applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.}
+}
+\value{
+The distance between the two trees according to the metric for the given value of lambda, or a function that produces the distance given a value of lambda.
+}
+\description{
+Comparison of two trees using the Kendall Colijn metric
+}
+\examples{
+
+## generate random trees
+tree.a <- rtree(6)
+tree.b <- rtree(6)
+treeDist(tree.a,tree.b) # lambda=0
+treeDist(tree.a,tree.b,1) # lambda=1
+dist.func <- treeDist(tree.a,tree.b,return.lambda.function=TRUE) # distance as a function of lambda
+dist.func(0) # evaluate at lambda=0. Equivalent to treeDist(tree.a,tree.b).
+## We can see how the distance changes when moving from focusing on topology to length:
+plot(sapply(seq(0,1,length.out=100), function(x) dist.func(x)), type="l",ylab="",xlab="")
+
+## The distance may also change if we emphasise the position of certain tips:
+plot(sapply(tree.a$tip.label, function(x) treeDist(tree.a,tree.b,emphasise.tips=x)),
+ xlab="Tip number",ylab="Distance when vector entries corresponding to tip are doubled")
+
+
+}
+\author{
+Jacob Almagro-Garcia \email{nativecoder at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/treeVec.Rd b/man/treeVec.Rd
new file mode 100644
index 0000000..b979454
--- /dev/null
+++ b/man/treeVec.Rd
@@ -0,0 +1,48 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/metrics.R
+\name{treeVec}
+\alias{treeVec}
+\title{Tree vector function}
+\usage{
+treeVec(tree, lambda = 0, return.lambda.function = FALSE,
+ emphasise.tips = NULL, emphasise.weight = 2)
+}
+\arguments{
+\item{tree}{an object of the class \code{phylo}}
+
+\item{lambda}{a number in [0,1] which specifies the extent to which topology (default, with lambda=0) or branch lengths (lambda=1) are emphasised. This argument is ignored if \code{return.lambda.function=TRUE}.}
+
+\item{return.lambda.function}{If true, a function that can be invoked with different lambda values is returned. This function returns the vector of metric values for the given lambda.}
+
+\item{emphasise.tips}{an optional list of tips whose entries in the tree vector should be emphasised. Defaults to \code{NULL}.}
+
+\item{emphasise.weight}{applicable only if a list is supplied to \code{emphasise.tips}, this value (default 2) is the number by which vector entries corresponding to those tips are emphasised.}
+}
+\value{
+The vector of values according to the metric, or a function that produces the vector given a value of lambda.
+}
+\description{
+Function which takes an object of class phylo and outputs the vector for the Kendall Colijn metric.
+The elements of the vector are numeric if \code{return.lambda.function=FALSE} (default),
+and otherwise they are functions of lambda.
+}
+\examples{
+
+## generate a random tree
+tree <- rtree(6)
+## topological vector of mrca distances from root:
+treeVec(tree)
+## vector of mrca distances from root when lambda=0.5:
+treeVec(tree,0.5)
+## vector of mrca distances as a function of lambda:
+vecAsFunction <- treeVec(tree,return.lambda.function=TRUE)
+## evaluate the vector at lambda=0.5:
+vecAsFunction(0.5)
+
+
+}
+\author{
+Jacob Almagro-Garcia \email{nativecoder at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/treespace.Rd b/man/treespace.Rd
new file mode 100644
index 0000000..6c70ebc
--- /dev/null
+++ b/man/treespace.Rd
@@ -0,0 +1,73 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/treespace.R
+\name{treespace}
+\alias{treespace}
+\title{Phylogenetic tree exploration}
+\usage{
+treespace(x, method = "treeVec", nf = NULL, return.tree.vectors = FALSE,
+ ...)
+}
+\arguments{
+\item{x}{an object of the class multiPhylo}
+
+\item{method}{the method for summarising the tree as a vector.
+Choose from:
+\code{treeVec} (default) the Kendall Colijn metric vector
+\code{BHV} the Billera, Holmes Vogtmann metric using \code{dist.multiPhylo} from package \code{distory}
+\code{KF} the Kuhner Felsenstein metric (branch score distance) using \code{KF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+\code{RF} the Robinson Foulds metric using \code{RF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
+\code{wRF} the weighted Robinson Foulds metric using \code{wRF.dist} from package \code{phangorn} (Note: this considers the trees as unrooted and issues a corresponding warning)
+\code{nNodes} the Steel & Penny tip-tip path difference metric, (topological, ignoring branch lengths), using \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+\code{patristic} the Steel & Penny tip-tip path difference metric, using branch lengths, calling \code{path.dist} from package \code{phangorn} (Note: this considers the trees as unrooted)
+others inherited from \code{distTips} in \code{adephylo}:
+\itemize{
+\item \code{Abouheif}: performs Abouheif's test. See Pavoine et al. (2008) and \code{adephylo}.
+\item \code{sumDD}: sum of direct descendants of all nodes on the path, related to Abouheif's test. See \code{adephylo}.
+}}
+
+\item{nf}{the number of principal components to retain}
+
+\item{return.tree.vectors}{option to also return the tree vectors. Note that this can use a lot of memory so defaults to \code{FALSE}.}
+
+\item{...}{further arguments to be passed to \code{method}.}
+}
+\description{
+Compares phylogenetic trees and maps them into a small number of dimensions for easy visualisation and identification of clusters.
+}
+\examples{
+
+## generate list of trees
+x <- rmtree(10, 20)
+names(x) <- paste("tree", 1:10, sep = "")
+
+## use treespace
+res <- treespace(x, nf=3)
+table.paint(as.matrix(res$D))
+scatter(res$pco)
+
+data(woodmiceTrees)
+woodmiceDists <- treespace(woodmiceTrees,nf=3)
+plot(woodmiceDists$pco$li[,1],woodmiceDists$pco$li[,2])
+woodmicedf <- woodmiceDists$pco$li
+if(require(ggplot2)){
+woodmiceplot <- ggplot(woodmicedf, aes(x=A1, y=A2)) # create plot
+woodmiceplot + geom_density2d(colour="gray80") + # contour lines
+geom_point(size=6, shape=1, colour="gray50") + # grey edges
+geom_point(size=6, alpha=0.2, colour="navy") + # transparent blue points
+xlab("") + ylab("") + theme_bw(base_family="") # remove axis labels and grey background
+}
+
+\dontrun{
+if(require(rgl)){
+plot3d(woodmicedf[,1], woodmicedf[,2], woodmicedf[,3], type="s", size=1.5,
+col="navy", alpha=0.5, xlab="", ylab="", zlab="")
+}
+}
+
+
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/treespaceServer.Rd b/man/treespaceServer.Rd
new file mode 100644
index 0000000..274ba3a
--- /dev/null
+++ b/man/treespaceServer.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/servers.R
+\name{treespaceServer}
+\alias{treespaceServer}
+\title{Web-based tree explorer}
+\usage{
+treespaceServer()
+}
+\description{
+This function opens up an application in a web browser for an interactive exploration of the diversity in a set of trees.
+For further details please see the "help" tab within the application.
+}
+\seealso{
+For convenience, \code{treespaceServer} is also available as a separate web app which can be used from any browser (it is not necessary to have \R installed): {\url{http://shiny.imperial-stats-experimental.co.uk/users/mlkendal/treespace/}}
+}
+\author{
+Thibaut Jombart \email{thibautjombart at gmail.com}
+
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/wiwMedTree.Rd b/man/wiwMedTree.Rd
new file mode 100644
index 0000000..048ff7c
--- /dev/null
+++ b/man/wiwMedTree.Rd
@@ -0,0 +1,44 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/transmissionTrees.R
+\name{wiwMedTree}
+\alias{wiwMedTree}
+\title{Median transmission tree}
+\usage{
+wiwMedTree(matList, sampled = NULL, weights = NULL)
+}
+\arguments{
+\item{matList}{a list of matrices, each of which is the output of \code{findMRCIs$mrciDepths}}
+
+\item{sampled}{a vector of node IDs which corresponds to those nodes which are sampled cases}
+
+\item{weights}{optional vector of weights to correspond to the entries of matList}
+}
+\value{
+Returns three objects:
+\itemize{
+\item \code{centre}: the mean of the matList entries, restricted to the sampled cases
+\item \code{distances}: for each entry of matList, its distance from \code{centre}
+\item \code{mindist}: the minimum of \code{distances}
+\item \code{median}: the number of the median entry of matList, i.e. the one(s) which achieve the \code{mindist} from the \code{centre}.
+}
+}
+\description{
+Function to find the median of a list of transmission scenarios
+}
+\examples{
+# create some simple "who infected whom" scenarios:
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+tree3 <- cbind(Infector=c(2,2,3,4,5),Infectee=c(1,3,4,5,6))
+# create list of the MRCI depth matrices:
+matList <- lapply(list(tree1,tree2,tree3), function(x) findMRCIs(x)$mrciDepths)
+
+# median tree, assuming all cases are sampled:
+wiwMedTree(matList)
+# median tree when cases 1, 2 and 4 are sampled:
+wiwMedTree(matList, sampled=c(1,2,4))
+
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/wiwTreeDist.Rd b/man/wiwTreeDist.Rd
new file mode 100644
index 0000000..216692f
--- /dev/null
+++ b/man/wiwTreeDist.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/transmissionTrees.R
+\name{wiwTreeDist}
+\alias{wiwTreeDist}
+\title{Transmission tree distance}
+\usage{
+wiwTreeDist(matList, sampled = NULL)
+}
+\arguments{
+\item{matList}{a list of matrices, each of which is the output of \code{findMRCIs$mrciDepths}}
+
+\item{sampled}{a vector of node IDs which corresponds to those nodes which are sampled cases. Default is to treat all nodes as sampled cases.}
+}
+\value{
+Returns a distance matrix, where entry (i,j) is the transmission tree distance between matrices i and j in \code{matList}
+}
+\description{
+Function to find the distance between transmission trees by comparing their MRCI depth matrices; to be precise, by finding the Euclidean distance between the tree vectors, restricted to their sampled node entries.
+}
+\examples{
+# create some simple "who infected whom" scenarios:
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+tree3 <- cbind(Infector=c(2,2,3,4,5),Infectee=c(1,3,4,5,6))
+# create list of the MRCI depth matrices:
+matList <- lapply(list(tree1,tree2,tree3), function(x) findMRCIs(x)$mrciDepths)
+
+# transmission tree distance, assuming all cases are sampled:
+wiwTreeDist(matList)
+# transmission tree distance when cases 1, 2 and 4 are sampled:
+wiwTreeDist(matList, sampled=c(1,2,4))
+
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
diff --git a/man/woodmiceTrees.Rd b/man/woodmiceTrees.Rd
new file mode 100644
index 0000000..c3b7c77
--- /dev/null
+++ b/man/woodmiceTrees.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.R
+\docType{data}
+\name{woodmiceTrees}
+\alias{woodmiceTrees}
+\title{Bootstrap trees from woodmouse dataset}
+\format{A multiPhylo object containing 201 trees, each with 15 tips}
+\source{
+A set of 15 sequences of the mitochondrial gene cytochrome b of the
+woodmouse (Apodemus sylvaticus) which is a subset of the data analysed by
+Michaux et al. (2003). The full data set is available through GenBank
+(accession numbers AJ511877 to AJ511987)
+}
+\description{
+These trees were created using the neighbour-joining and bootstrapping
+example from the ape documentation.
+}
+\references{
+Michaux, J. R., Magnanou, E., Paradis, E., Nieberding, C. and
+Libois, R. (2003) Mitochondrial phylogeography of the Woodmouse (Apodemus
+sylvaticus) in the Western Palearctic region. \emph{Molecular Ecology}, 12,
+685-697
+}
+\author{
+Michelle Kendall \email{michelle.louise.kendall at gmail.com}
+}
+\keyword{datasets}
diff --git a/src/CPP_update_combinations.cpp b/src/CPP_update_combinations.cpp
new file mode 100644
index 0000000..a9c76d5
--- /dev/null
+++ b/src/CPP_update_combinations.cpp
@@ -0,0 +1,31 @@
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+void updateDistancesWithCombinations(NumericVector& length_root_distances,
+ NumericVector& topological_root_distances,
+ IntegerVector& left_partition,
+ IntegerVector& right_partition,
+ IntegerVector& index_offsets,
+ double distance_to_root,
+ int edges_to_root)
+{
+ // Iterate through all combinations.
+ for(int i=0; i < left_partition.size(); ++i) {
+ for(int j=0; j < right_partition.size(); ++j) {
+ int first_leaf = left_partition[i];
+ int second_leaf = right_partition[j];
+ // Because of the symmetric distances.
+ if(left_partition[i] > right_partition[j]) {
+ first_leaf = right_partition[j];
+ second_leaf = left_partition[i];
+ }
+ // Roll the index (notice we take into account C++ indices here, starting at 0).
+ int combination_index = index_offsets[first_leaf-1] + (second_leaf - first_leaf) - 1;
+ // Update the vectors.
+ length_root_distances[combination_index] = distance_to_root;
+ topological_root_distances[combination_index] = edges_to_root;
+ }
+ }
+}
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
new file mode 100644
index 0000000..49e86e7
--- /dev/null
+++ b/src/RcppExports.cpp
@@ -0,0 +1,23 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// updateDistancesWithCombinations
+void updateDistancesWithCombinations(NumericVector& length_root_distances, NumericVector& topological_root_distances, IntegerVector& left_partition, IntegerVector& right_partition, IntegerVector& index_offsets, double distance_to_root, int edges_to_root);
+RcppExport SEXP treespace_updateDistancesWithCombinations(SEXP length_root_distancesSEXP, SEXP topological_root_distancesSEXP, SEXP left_partitionSEXP, SEXP right_partitionSEXP, SEXP index_offsetsSEXP, SEXP distance_to_rootSEXP, SEXP edges_to_rootSEXP) {
+BEGIN_RCPP
+ Rcpp::RNGScope rcpp_rngScope_gen;
+ Rcpp::traits::input_parameter< NumericVector& >::type length_root_distances(length_root_distancesSEXP);
+ Rcpp::traits::input_parameter< NumericVector& >::type topological_root_distances(topological_root_distancesSEXP);
+ Rcpp::traits::input_parameter< IntegerVector& >::type left_partition(left_partitionSEXP);
+ Rcpp::traits::input_parameter< IntegerVector& >::type right_partition(right_partitionSEXP);
+ Rcpp::traits::input_parameter< IntegerVector& >::type index_offsets(index_offsetsSEXP);
+ Rcpp::traits::input_parameter< double >::type distance_to_root(distance_to_rootSEXP);
+ Rcpp::traits::input_parameter< int >::type edges_to_root(edges_to_rootSEXP);
+ updateDistancesWithCombinations(length_root_distances, topological_root_distances, left_partition, right_partition, index_offsets, distance_to_root, edges_to_root);
+ return R_NilValue;
+END_RCPP
+}
diff --git a/src/treespace_init.c b/src/treespace_init.c
new file mode 100644
index 0000000..1e99f72
--- /dev/null
+++ b/src/treespace_init.c
@@ -0,0 +1,22 @@
+#include <R.h>
+#include <Rinternals.h>
+#include <stdlib.h> // for NULL
+#include <R_ext/Rdynload.h>
+
+/* FIXME:
+ Check these declarations against the C/Fortran source code.
+*/
+
+/* .Call calls */
+extern SEXP treespace_updateDistancesWithCombinations(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
+
+static const R_CallMethodDef CallEntries[] = {
+ {"treespace_updateDistancesWithCombinations", (DL_FUNC) &treespace_updateDistancesWithCombinations, 7},
+ {NULL, NULL, 0}
+};
+
+void R_init_treespace(DllInfo *dll)
+{
+ R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..4013496
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,4 @@
+library(testthat)
+library(treespace)
+
+test_check("treespace")
diff --git a/tests/testthat/testbasics.R b/tests/testthat/testbasics.R
new file mode 100644
index 0000000..15f2695
--- /dev/null
+++ b/tests/testthat/testbasics.R
@@ -0,0 +1,136 @@
+library(testthat)
+library(treespace)
+library(ape)
+
+############################
+# create some test objects
+############################
+
+tree_a <- rtree(100)
+tree_b <- rtree(100)
+n <- 10 # number of trees for multiphylo object
+trees <- rmtree(n,100)
+l <- runif(1) # a random value for lambda
+
+############################
+# test that evaluating at lambda immediately, or via the function, gives the same result
+############################
+
+test_that("treeVec calculated at lambda equals treeVec function evaluated at lambda", {
+ expect_equal(treeVec(tree_a,l),treeVec(tree_a,return.lambda.function=TRUE)(l))
+ })
+
+test_that("treeDist calculated at lambda equals treeDist function evaluated at lambda", {
+ expect_equal(treeDist(tree_a,tree_b,l),treeDist(tree_a,tree_b,return.lambda.function=TRUE)(l))
+ })
+
+test_that("multiDist calculated at lambda equals multiDist function evaluated at lambda", {
+ expect_equal(multiDist(trees,l),multiDist(trees,return.lambda.function=TRUE)(l))
+ })
+
+test_that("refTreeDist calculated at lambda equals refTreeDist function evaluated at lambda", {
+ expect_equal(refTreeDist(tree_a,trees,l),refTreeDist(tree_a,trees,return.lambda.function=TRUE)(l))
+})
+
+############################
+# test that functions match as they should, including when tips are emphasised
+############################
+
+test_that("treeDist equals Euclidean distance between corresponding vectors", {
+ expect_equal(treeDist(tree_a,tree_b), sqrt(sum((treeVec(tree_a) - treeVec(tree_b))^2)))
+ expect_equal(treeDist(tree_a,tree_b,emphasise.tips = c("t1","t2")), sqrt(sum((treeVec(tree_a,emphasise.tips = c("t1","t2")) - treeVec(tree_b,emphasise.tips = c("t1","t2")))^2)))
+ })
+
+test_that("treeDist equals corresponding entry of multiDist", {
+ expect_equal(treeDist(trees[[1]],trees[[2]]), multiDist(trees)[[1]])
+ expect_equal(treeDist(trees[[1]],trees[[2]],emphasise.tips = c("t1","t2")), multiDist(trees,emphasise.tips = c("t1","t2"))[[1]])
+ })
+
+test_that("treeDist equals corresponding entry of refTreeDist", {
+ expect_equal(treeDist(tree_a,trees[[1]]), refTreeDist(tree_a,trees)[[1]])
+ expect_equal(treeDist(tree_a,trees[[1]],emphasise.tips = c("t1","t2")), refTreeDist(tree_a,trees,emphasise.tips = c("t1","t2"))[[1]])
+})
+
+test_that("multiDist equals the distance matrix from treespace", {
+ treedistMatrix <- treespace(trees,nf=2)$D
+ treedistMatrix0.5 <- treespace(trees,nf=2,lambda=l)$D
+ multidistMatrixFunction <- multiDist(trees,return.lambda.function=TRUE)
+ expect_equal(multidistMatrixFunction(0)[[n]],treedistMatrix[[n]])
+ expect_equal(multidistMatrixFunction(l)[[n]],treedistMatrix0.5[[n]])
+ expect_equal(treespace(trees,nf=2,emphasise.tips=c("t1","t2"))$D[[n]],multiDist(trees,emphasise.tips=c("t1","t2"))[[n]])
+ })
+
+test_that("medTree results are consistent with treeVec", {
+ geom <- medTree(trees)
+ expect_equal(geom$mindist,sqrt(sum((geom$centre - treeVec(geom$trees[[1]]))^2))) # mindist, centre and median are internally consistent, and consistent with treeVec
+ expect_equal(geom$mindist,min(geom$distances)) # mindist equals the minimum entry in `distances'
+ })
+
+test_that("medTree results are consistent whether the trees or their vectors are supplied", {
+ expect_equal(medTree(trees)$mindist,medTree(treespace(trees,nf=2, return.tree.vectors = TRUE)$vectors)$mindist)
+ })
+
+############################
+# test that save_memory versions match non-save_memory versions
+############################
+
+test_that("save_memory version of multiDist equals normal multiDist", {
+ expect_equal(multiDist(trees,save.memory=TRUE), multiDist(trees))
+ expect_equal(multiDist(trees,l,save.memory=TRUE), multiDist(trees,l))
+ })
+
+# NOTE: The outputs are different classes. Would like to be able to remove "as.numeric" here
+test_that("save_memory version of medTree equals normal medTree", {
+ expect_equal(medTree(trees,save.memory=TRUE)$centre, as.numeric(medTree(trees)$centre))
+ })
+
+############################
+# test for errors and warnings
+############################
+
+test_that("error is given if lambda is outside of [0,1]", {
+ expect_error(treeVec(tree_a,-1))
+ expect_error(treeVec(tree_a,2))
+ expect_error(treeDist(tree_a,tree_b,-1))
+ expect_error(treeDist(tree_a,tree_b,2))
+ expect_error(multiDist(trees,-1))
+ expect_error(multiDist(trees,2))
+ expect_error(medTree(trees,-1))
+ expect_error(medTree(trees,2))
+ })
+
+test_that("error is given if input is not of class phylo / multiphylo", {
+ expect_error(treeVec(trees))
+ expect_error(treeDist(trees))
+ expect_error(multiDist(tree_a))
+ expect_error(medTree(tree_a))
+ expect_error(findGroves(tree_a))
+ })
+
+test_that("error is given if input tree is unrooted", {
+ unrootedtree <- read.tree(text="(A:1,B:1,C:1);") # an unrooted tree
+ expect_error(treeVec(unrootedtree))
+ })
+
+test_that("warning is given if tree edge lengths are not defined, then they are set to 1", {
+ newicktree <- read.tree(text="((A,B),C);") # a tree without defined edge lengths
+ expect_warning(treeVec(newicktree))
+ })
+
+test_that("error is given if trees have different tip labels", {
+ tree_c <- rtree(99)
+ tree_d <- tree_a
+ tree_d$tip.label <- 1:100 # note that tree_a has tip labels t1, t2, ...
+ expect_error(treeDist(tree_a,tree_c))
+ expect_error(treeDist(tree_a,tree_d))
+ })
+
+test_that("error is given if weights vector is not of length n", {
+ expect_error(medTree(trees,weights=rep(1,n+1)))
+ expect_error(medTree(trees,weights=rep(1,n+1),return.lambda.function=TRUE))
+ })
+
+test_that("warning is given for the combination return.lambda.function=TRUE, save.memory=TRUE", {
+ expect_warning(multiDist(trees,return.lambda.function=TRUE, save.memory=TRUE))
+ expect_warning(medTree(trees,return.lambda.function=TRUE, save.memory=TRUE))
+ })
diff --git a/vignettes/DengueVignette.Rmd b/vignettes/DengueVignette.Rmd
new file mode 100644
index 0000000..42f9aac
--- /dev/null
+++ b/vignettes/DengueVignette.Rmd
@@ -0,0 +1,338 @@
+---
+title: "treespace worked example: Dengue trees"
+author: "Michelle Kendall, Thibaut Jombart"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace worked example: Dengue trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+```
+
+
+This vignette demonstrates the use of *treespace* to compare a collection of trees.
+For this example we use trees inferred from 17 dengue virus serotype 4 sequences from Lanciotti et al. (1997).
+We include a sample of trees from BEAST (v1.8), as well as creating neighbour-joining (NJ) and maximum-likelihood (ML) trees.
+
+
+Loading *treespace* and data:
+-------------
+
+Load the required packages:
+```{r load, message=FALSE, warning=FALSE}
+library("treespace")
+library("phangorn")
+```
+
+Load BEAST trees:
+```{r load_BEAST_trees}
+data(DengueTrees)
+```
+
+We load a random sample of 500 of the trees (from the second half of the posterior) produced using BEAST v1.8 with xml file 4 from Drummond and Rambaut (2007). It uses the standard GTR + Gamma + I substitution model with uncorrelated lognormal-distributed relaxed molecular clock. Each tree has 17 tips.
+
+For convenience in our initial analysis we will take a random sample of 200 of these trees; sample sizes can be increased later.
+```{r sample_BEAST_trees}
+set.seed(123)
+BEASTtrees <- DengueTrees[sample(1:length(DengueTrees),200)]
+```
+
+Load nucleotide sequences:
+```{r load_seqs}
+data(DengueSeqs)
+```
+
+Creating neighbour-joining and maximum likelihood trees:
+-------------
+
+Create a neighbour-joining (NJ) tree using the Tamura and Nei (1993) model (see `?dist.dna` for more information) and root it on the outgroup `"D4Thai63"`:
+```{r make_NJ}
+makeTree <- function(x){
+ tree <- nj(dist.dna(x, model = "TN93"))
+ tree <- root(tree, resolve.root=TRUE, outgroup="D4Thai63")
+ tree
+}
+DnjRooted <- makeTree(DengueSeqs)
+plot(DnjRooted)
+```
+
+We use `boot.phylo` to bootstrap the tree:
+```{r make_NJ_boots, results="hide"}
+Dnjboots <- boot.phylo(DnjRooted, DengueSeqs, B=100,
+ makeTree, trees=TRUE, rooted=TRUE)
+Dnjboots
+```
+
+and we can plot the tree again, annotating it with the bootstrap clade support values:
+```{r see_NJ_boots}
+plot(DnjRooted)
+drawSupportOnEdges(Dnjboots$BP)
+```
+
+We create a maximum-likelihood (ML) tree and root it as before:
+```{r make_ML, results="hide", message=FALSE}
+Dfit.ini <- pml(DnjRooted, as.phyDat(DengueSeqs), k=4)
+Dfit <- optim.pml(Dfit.ini, optNni=TRUE, optBf=TRUE,
+ optQ=TRUE, optGamma=TRUE, model="GTR")
+# root:
+DfitTreeRooted <- root(Dfit$tree, resolve.root=TRUE, outgroup="D4Thai63")
+```
+
+View the ML tree:
+```{r view_ML}
+plot(DfitTreeRooted)
+```
+
+Create bootstrap trees:
+```{r make_ML_boots, results="hide"}
+# bootstrap supports:
+DMLboots <- bootstrap.pml(Dfit, optNni=TRUE)
+# root:
+DMLbootsrooted <- lapply(DMLboots, function(x) root(x, resolve.root=TRUE, outgroup="D4Thai63"))
+class(DMLbootsrooted) <- "multiPhylo"
+
+```
+
+Plot the ML tree again, with bootstrap support values:
+```{r see_ML_boots}
+plotBS(DfitTreeRooted, DMLboots, type="phylogram")
+```
+
+Using *treespace* to compare trees
+-------------
+
+We now use the function `treespace` to find and plot distances between all these trees:
+
+```{r run_treespace}
+# collect the trees into a single object of class multiPhylo:
+DengueTrees <- c(BEASTtrees, Dnjboots$trees, DMLbootsrooted,
+ DnjRooted, DfitTreeRooted)
+class(DengueTrees) <- "multiPhylo"
+# add tree names:
+names(DengueTrees)[1:200] <- paste0("BEAST",1:200)
+names(DengueTrees)[201:300] <- paste0("NJ_boots",1:100)
+names(DengueTrees)[301:400] <- paste0("ML_boots",1:100)
+names(DengueTrees)[[401]] <- "NJ"
+names(DengueTrees)[[402]] <- "ML"
+# create vector corresponding to tree inference method:
+Dtype <- c(rep("BEAST",200),rep("NJboots",100),rep("MLboots",100),"NJ","ML")
+
+# use treespace to find and project the distances:
+Dscape <- treespace(DengueTrees, nf=5)
+
+# simple plot:
+plotGrovesD3(Dscape$pco, groups=Dtype)
+```
+
+The function `plotGrovesD3` produces interactive d3 plots which enable zooming, moving, tooltip text and legend hovering. We now refine the plot with colour-blind friendly colours (selected using [ColorBrewer2](http://colorbrewer2.org/)), bigger points, varying symbols and point opacity to demonstrate the NJ and ML trees, informative legend title and smaller legend width:
+
+```{r make_better_plot}
+Dcols <- c("#1b9e77","#d95f02","#7570b3")
+Dmethod <- c(rep("BEAST",200),rep("NJ",100),rep("ML",100),"NJ","ML")
+Dbootstraps <- c(rep("replicates",400),"NJ","ML")
+Dhighlight <- c(rep(1,400),2,2)
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+We can also add tree labels to the plot. Where these overlap, the user can use "drag and drop" to move them around for better visibility.
+
+```{r make_better_plot_with_labels}
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ treeNames = names(DengueTrees), # add the tree names as labels
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+Alternatively, where labels are too cluttered, it may be preferable not to plot them but to make the tree names available as tooltip text instead:
+```{r make_better_plot_with_tooltips}
+plotGrovesD3(Dscape$pco,
+ groups=Dmethod,
+ tooltip_text = names(DengueTrees), # add the tree names as tooltip text
+ colors=Dcols,
+ col_lab="Tree type",
+ size_var=Dhighlight,
+ size_range = c(100,500),
+ size_lab="",
+ symbol_var=Dbootstraps,
+ symbol_lab="",
+ point_opacity=c(rep(0.4,400),1,1),
+ legend_width=80)
+```
+
+The scree plot is available as part of the `treespace` output:
+```{r scree_plot}
+barplot(Dscape$pco$eig, col="navy")
+```
+
+We can also view the plot in 3D:
+```{r load_rgl}
+library(rgl)
+```
+
+```{r plot_3D, rgl=TRUE, webgl=TRUE}
+Dcols3D <- c(rep(Dcols[[1]],200),rep(Dcols[[2]],100),rep(Dcols[[3]],100),Dcols[[2]],Dcols[[3]])
+rgl::plot3d(Dscape$pco$li[,1],Dscape$pco$li[,2],Dscape$pco$li[,3],
+ type="s",
+ size=c(rep(1.5,400),3,3),
+ col=Dcols3D,
+ xlab="", ylab="", zlab="")
+```
+
+*treespace* analysis
+-------------
+
+From these plots we can see that *treespace* has identified variation in the trees according to the Kendall Colijn metric ($\lambda=0$, ignoring branch lengths).
+The NJ and ML bootstrap trees have broadly similar topologies but are different from any of the BEAST trees.
+We can check whether any bootstrap trees have the same topology as either the NJ or ML tree, as follows:
+
+```{r NJ_and_ML_overlap}
+# trees with the same topology as the NJ tree:
+which(as.matrix(Dscape$D)["NJ",]==0)
+# trees with the same topology as the ML tree:
+which(as.matrix(Dscape$D)["ML",]==0)
+```
+
+This shows that the NJ tree has the same topology as one NJ bootstrap tree and one ML bootstrap tree. The ML tree has the same topology as 15 ML bootstrap trees, but no NJ bootstrap trees.
+
+We can compare pairs of trees using the `plotTreeDiff` function to see exactly where their differences arise.
+Tips with identical ancestry in the two trees are coloured grey, whereas tips with differing ancestry are coloured peach-red, with the colour darkening according to the number of ancestral differences found at each tip.
+Since we are comparing the trees topologically (ignoring branch lengths, for the moment), we plot with constant branch lengths for clarity.
+```{r compare_trees_NJ_v_ML}
+# comparing NJ and ML:
+plotTreeDiff(DnjRooted,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(DnjRooted,DfitTreeRooted)
+```
+
+For pairwise comparisons it is helpful to find a small number of representative trees.
+We can find a geometric median tree from the BEAST trees using the `medTree` function:
+```{r make_BEAST_median}
+BEASTmed <- medTree(BEASTtrees)
+```
+
+There are two median trees, with identical topology:
+```{r compare_BEAST_meds}
+BEASTmed$trees
+treeDist(BEASTmed$trees[[1]],BEASTmed$trees[[2]])
+```
+
+so we may select one of them as a BEAST representative tree.
+Note that for a more thorough analysis it may be appropriate to identify clusters among the BEAST trees and select a summary tree from each cluster: we demonstrate this approach later in the vignette.
+
+```{r save_BEAST_median}
+BEASTrep <- BEASTmed$trees[[1]]
+```
+
+```{r compare_BEAST_to_other_trees}
+# comparing BEAST median and NJ:
+plotTreeDiff(BEASTrep,DnjRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DnjRooted)
+# comparing BEAST median and ML:
+plotTreeDiff(BEASTrep,DfitTreeRooted, use.edge.length=FALSE)
+treeDist(BEASTrep,DfitTreeRooted)
+# comparing BEAST median to a random BEAST tree:
+num <- runif(1,1,200)
+randomBEASTtree <- BEASTtrees[[num]]
+plotTreeDiff(BEASTrep, randomBEASTtree, use.edge.length=FALSE)
+treeDist(BEASTrep,randomBEASTtree)
+```
+
+Using *treespace* to analyse the BEAST trees in more detail:
+-------------
+
+We used TreeAnnotator (Drummond and Rambaut, 2007) to create a Maximum Clade Credibility (MCC) tree from amongst the BEAST trees.
+```{r BEASTtrees}
+# load the MCC tree
+data(DengueBEASTMCC)
+# concatenate with other BEAST trees
+BEAST201 <- c(BEASTtrees, DengueBEASTMCC)
+# compare using treespace:
+BEASTscape <- treespace(BEAST201, nf=5)
+# simple plot:
+plotGrovesD3(BEASTscape$pco)
+```
+
+There appear to be clusters of tree topologies within the BEAST trees. We can use the function `findGroves` to identify clusters:
+```{r BEASTtrees_clusters}
+# find clusters or 'groves':
+BEASTGroves <- findGroves(BEASTscape, nclust=4, clustering = "single")
+```
+
+and to find a median tree per cluster:
+```{r BEASTtrees_meds}
+# find median tree(s) per cluster:
+BEASTMeds <- medTree(BEAST201, groups=BEASTGroves$groups)
+# for each cluster, select a single median tree to represent it:
+BEASTMedTrees <- c(BEASTMeds$`1`$trees[[1]],
+ BEASTMeds$`2`$trees[[1]],
+ BEASTMeds$`3`$trees[[1]],
+ BEASTMeds$`4`$trees[[1]])
+```
+
+We can now make the plot again, highlighting the MCC tree and the four median trees:
+```{r BEASTtrees_plot, warning=FALSE}
+# extract the numbers from the tree list 'BEASTtrees' which correspond to the median trees:
+BEASTMedTreeNums <-c(which(BEASTGroves$groups==1)[[BEASTMeds$`1`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==2)[[BEASTMeds$`2`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==3)[[BEASTMeds$`3`$treenumbers[[1]]]],
+ which(BEASTGroves$groups==4)[[BEASTMeds$`4`$treenumbers[[1]]]])
+# prepare a vector to highlight median and MCC trees
+highlightTrees <- rep(1,201)
+highlightTrees[[201]] <- 2
+highlightTrees[BEASTMedTreeNums] <- 2
+# prepare colours:
+BEASTcols <- c("#66c2a5","#fc8d62","#8da0cb","#e78ac3")
+
+# plot:
+plotGrovesD3(BEASTscape$pco,
+ groups=as.vector(BEASTGroves$groups),
+ colors=BEASTcols,
+ col_lab="Cluster",
+ symbol_var = highlightTrees,
+ size_range = c(60,600),
+ size_var = highlightTrees,
+ legend_width=0)
+```
+
+To understand the differences between the representative trees we can use `plotTreeDiff` again, for example:
+```{r BEASTtree_diffs}
+# differences between the MCC tree and the median from the largest cluster:
+treeDist(DengueBEASTMCC,BEASTMedTrees[[1]])
+plotTreeDiff(DengueBEASTMCC,BEASTMedTrees[[1]], use.edge.length=FALSE)
+# differences between the median trees from clusters 1 and 2:
+treeDist(BEASTMedTrees[[1]],BEASTMedTrees[[2]])
+plotTreeDiff(BEASTMedTrees[[1]],BEASTMedTrees[[2]], use.edge.length=FALSE)
+```
+
+
+References
+--------------
+[1] Drummond, A. J., and Rambaut, A. (2007) BEAST: Bayesian evolutionary analysis by sampling trees. BMC Evolutionary Biology, 7(1), 214.
+
+[2] Lanciotti, R. S., Gubler, D. J., and Trent, D. W. (1997) Molecular evolution and phylogeny of dengue-4 viruses. Journal of General Virology, 78(9), 2279-2286.
+
diff --git a/vignettes/TransmissionTreesVignette.Rmd b/vignettes/TransmissionTreesVignette.Rmd
new file mode 100644
index 0000000..0458245
--- /dev/null
+++ b/vignettes/TransmissionTreesVignette.Rmd
@@ -0,0 +1,214 @@
+---
+title: "treespace worked example: Transmission trees"
+author: "Michelle Kendall"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace worked example: Transmission trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+```
+
+
+This vignette demonstrates the use of *treespace* to compare a collection of transmission trees, as proposed in Kendall, Ayabina & Colijn, 2016 [arXiv:1609.09051](http://arxiv.org/abs/1609.09051).
+
+First we load the package *treespace*:
+
+```{r load, message=FALSE}
+library(treespace)
+```
+
+*treespace* contains three functions for handling and comparing transmission trees:
+
+1) `findMRCIs()` which takes a "who infected whom matrix" (the information about infectors and infectees; more on this below) and outputs:
+
++ `sourceCase`: the number of the node which is the source case, i.e. the common infector of all cases (outputs a warning if there is more than one source case).
+
++ `mrcis`: a matrix where, for each pair of individuals i and j, the entry (i,j) is the node number of their MRCI. Note that if i infected j then this entry is i itself.
+
++ `mrciDepths`: a matrix where, for each pair of individuals i and j, the entry (i,j) is the *depth* of their MRCI, defined as the number of edges from the source case. The source case has depth zero, its direct infectees have depth 1, and so on.
+
+2) `wiwTreeDist()` which takes a list of `mrciDepths` matrices and computes the distances between them. You have to supply the list of sampled cases in which you are interested, and then it takes the Euclidean distance between each pair of matrices restricted to the sampled cases (and written long-hand, as a vector)
+
+3) `wiwMedTree()` which takes a list of `mrciDepths` matrices, the list of sampled cases, an optional list of weights, and outputs the median transmission tree
+
+Examples
+---------
+
+We define a "who infected whom matrix" as a matrix of two columns, where the first represents the infectors and the second represents their infectees. For example, a simple transmission chain could be represented like this:
+```{r tree1}
+tree1 <- cbind(Infector=1:5,Infectee=2:6)
+tree1
+```
+
+This can be easily visualised as a transmission chain using graph plotting packages such as *igraph* or *visNetwork*:
+
+```{r igraph_tree1, message=FALSE}
+library(igraph)
+# set plotting options:
+igraph_options(vertex.size=15,
+ vertex.color="cyan",
+ vertex.label.cex=2,
+ edge.color="lightgrey",
+ edge.arrow.size=1)
+
+tree1graph <- graph_from_edgelist(tree1)
+plot(tree1graph)
+```
+
+Applying the function `findMRCIs` gives the following:
+```{r simple_wiwMRCIs}
+findMRCIs(tree1)
+```
+
+### Comparing three simple trees
+
+Suppose we had other hypotheses for the transmission tree which describes who infected whom amongst these six cases:
+```{r trees2_and_3}
+# a second scenario:
+tree2 <- cbind(Infector=c(1,5,2,2,3),Infectee=2:6)
+tree2
+tree2graph <- graph_from_edgelist(tree2)
+plot(tree2graph)
+
+# and a third scenario:
+tree3 <- cbind(Infector=c(2,2,2,2,6),Infectee=c(1,3,4,6,5))
+tree3
+tree3graph <- graph_from_edgelist(tree3)
+plot(tree3graph)
+```
+
+Then we can use *treespace* functions to make the following comparisons:
+```{r tree123_comparison}
+m1 <- findMRCIs(tree1) # find the source case, MRCIs and MRCI depths for tree 1
+m2 <- findMRCIs(tree2)
+m3 <- findMRCIs(tree3)
+
+matList <- list(m1$mrciDepths,m2$mrciDepths,m3$mrciDepths) # create a list of the mrciDepths matrices
+matList
+wiwTreeDist(matList, sampled=1:6) # find the Euclidean distances between these matrices, where all six cases are sampled
+```
+
+If we had only sampled cases 4, 5 and 6, so that "1", "2" and "3" could be regarded as arbitrary names of inferred, unsampled cases, we would compute:
+```{r tree123_sampled4:6}
+wiwTreeDist(matList, sampled=4:6)
+```
+which substantially changes the measures of similarities and differences between the trees.
+
+### Comparing many trees using an MDS plot
+
+Finally, we demonstrate comparing a larger set of transmission trees and finding the median:
+
+```{r trees1000}
+set.seed(123)
+num <- 500
+
+# create a list of 500 random transmission trees with 11 cases, where the source case is fixed as case 1:
+treelistSC1 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge # effectively creating a random transmission scenario
+ relabel <- sample(1:11) # create a relabelling so that infections don't all happen in numerical order, but we force the source case to be 1:
+ relabel[[which(relabel==1)]] <- relabel[[7]]
+ relabel[[7]] <- 1
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# create 500 more random transmission trees, but where the source case is fixed as case 2:
+treelistSC2 <- lapply(1:num, function(x) {
+ edges <- rtree(6)$edge
+ relabel <- sample(1:11)
+ relabel[[which(relabel==2)]] <- relabel[[7]]
+ relabel[[7]] <- 2
+ relabelledEdges1 <- sapply(edges[,1], function(x) relabel[[x]])
+ relabelledEdges2 <- sapply(edges[,2], function(x) relabel[[x]])
+ cbind(relabelledEdges1,relabelledEdges2)
+})
+
+# combine:
+combinedLists <- c(treelistSC1,treelistSC2)
+
+# get mrciDepths matrices:
+matList1000 <- lapply(combinedLists, function(x)
+ findMRCIs(x)$mrciDepths
+)
+
+# find pairwise tree distances, treating all cases as sampled:
+WiwDists1000 <- wiwTreeDist(matList1000, sampled=1:11)
+```
+
+Now that we have a pairwise distance matrix we can use multidimensional scaling (MDS) to view the relative distances between the trees in a 2D projection. We will colour the points in the projection by the "depth" of the corresponding tree, and use symbols to indicate the source case. For "depth" here we simply use the mean of each "mrciDepths" matrix.
+
+```{r wiw_MDS1000, message=FALSE}
+wiwMDS <- dudi.pco(WiwDists1000, scannf=FALSE, nf=3)
+
+library(ggplot2)
+library(RColorBrewer)
+
+wiwPlot <- ggplot(wiwMDS$li, aes(x=wiwMDS$li[,1],y=wiwMDS$li[,2]))
+
+# prepare aesthetics
+depths <- sapply(matList1000, function(x) mean(x))
+sourcecase <- c(rep("1",num),rep("2",num))
+
+# prepare colours:
+colfunc <- colorRampPalette(brewer.pal(10,"Spectral"), space="Lab")
+
+wiwPlot +
+ geom_point(size=4, colour="gray60", aes(shape=sourcecase)) +
+ geom_point(size=3, aes(colour=depths, shape=sourcecase)) +
+ scale_colour_gradientn("Mean of v\n",
+ colours=colfunc(7),
+ guide = guide_colourbar(barheight=10)) +
+ scale_shape_discrete("Source case\n", solid=T, guide = guide_legend(keyheight = 3, keywidth=1.5)) +
+ theme_bw(base_size = 12, base_family = "") +
+ theme_bw(base_size = 12, base_family = "") +
+ theme(
+ legend.title = element_text(size=20),
+ legend.text = element_text(size=20),
+ axis.text.x = element_text(size=20), axis.text.y = element_text(size=20)) +
+ xlab("") + ylab("")
+```
+
+The symmetry in the plot corresponds to the different source cases, and the trees are also clearly separated by depth.
+
+### Median trees
+
+If our transmission trees corresponded to real data it could be meaningful to find a single representative tree. To find the geometric median tree(s) from a collection, we use the function `wiwMedTree`:
+
+```{r wiwMedian}
+med <- wiwMedTree(matList1000)
+```
+
+This returns a list with components:
+
+```{r wiwMedian2}
+names(med)
+```
+
+* `centre` is the mean vector (which may not necessarily correspond to a valid transmission tree with a single source case)
+
+* `distances` gives the distance of each tree from the centre, as a vector
+
+* `mindist` gives the minimum of these distances
+
+* `median` gives the number(s) of the median tree(s)
+
+Here the median tree is:
+
+```{r wiwMedTree}
+med$median
+```
+
+and looks like this:
+
+```{r wiwMedTreePlot}
+medgraph <- graph_from_edgelist(combinedLists[[med$median]])
+plot(medgraph)
+```
\ No newline at end of file
diff --git a/vignettes/figs/BEASTtree_diffs-1.png b/vignettes/figs/BEASTtree_diffs-1.png
new file mode 100644
index 0000000..39399f1
Binary files /dev/null and b/vignettes/figs/BEASTtree_diffs-1.png differ
diff --git a/vignettes/figs/BEASTtree_diffs-2.png b/vignettes/figs/BEASTtree_diffs-2.png
new file mode 100644
index 0000000..1ed0c86
Binary files /dev/null and b/vignettes/figs/BEASTtree_diffs-2.png differ
diff --git a/vignettes/figs/compare_BEAST_to_other_trees-1.png b/vignettes/figs/compare_BEAST_to_other_trees-1.png
new file mode 100644
index 0000000..df9900f
Binary files /dev/null and b/vignettes/figs/compare_BEAST_to_other_trees-1.png differ
diff --git a/vignettes/figs/compare_BEAST_to_other_trees-2.png b/vignettes/figs/compare_BEAST_to_other_trees-2.png
new file mode 100644
index 0000000..8c3474f
Binary files /dev/null and b/vignettes/figs/compare_BEAST_to_other_trees-2.png differ
diff --git a/vignettes/figs/compare_BEAST_to_other_trees-3.png b/vignettes/figs/compare_BEAST_to_other_trees-3.png
new file mode 100644
index 0000000..ed5631a
Binary files /dev/null and b/vignettes/figs/compare_BEAST_to_other_trees-3.png differ
diff --git a/vignettes/figs/compare_trees_NJ_v_ML-1.png b/vignettes/figs/compare_trees_NJ_v_ML-1.png
new file mode 100644
index 0000000..1dc0ac1
Binary files /dev/null and b/vignettes/figs/compare_trees_NJ_v_ML-1.png differ
diff --git a/vignettes/figs/construction.png b/vignettes/figs/construction.png
new file mode 100644
index 0000000..bedc093
Binary files /dev/null and b/vignettes/figs/construction.png differ
diff --git a/vignettes/figs/distances-1.png b/vignettes/figs/distances-1.png
new file mode 100644
index 0000000..ed33feb
Binary files /dev/null and b/vignettes/figs/distances-1.png differ
diff --git a/vignettes/figs/distances-2.png b/vignettes/figs/distances-2.png
new file mode 100644
index 0000000..aa67a1b
Binary files /dev/null and b/vignettes/figs/distances-2.png differ
diff --git a/vignettes/figs/distances_readme-1.png b/vignettes/figs/distances_readme-1.png
new file mode 100644
index 0000000..c8dd83a
Binary files /dev/null and b/vignettes/figs/distances_readme-1.png differ
diff --git a/vignettes/figs/distances_readme-2.png b/vignettes/figs/distances_readme-2.png
new file mode 100644
index 0000000..bbf96c6
Binary files /dev/null and b/vignettes/figs/distances_readme-2.png differ
diff --git a/vignettes/figs/findgroves-with-emphasis_readme-1.png b/vignettes/figs/findgroves-with-emphasis_readme-1.png
new file mode 100644
index 0000000..d0deaf9
Binary files /dev/null and b/vignettes/figs/findgroves-with-emphasis_readme-1.png differ
diff --git a/vignettes/figs/igraph_options-1.png b/vignettes/figs/igraph_options-1.png
new file mode 100644
index 0000000..e55432d
Binary files /dev/null and b/vignettes/figs/igraph_options-1.png differ
diff --git a/vignettes/figs/igraph_tree1-1.png b/vignettes/figs/igraph_tree1-1.png
new file mode 100644
index 0000000..7913b70
Binary files /dev/null and b/vignettes/figs/igraph_tree1-1.png differ
diff --git a/vignettes/figs/make_NJ-1.png b/vignettes/figs/make_NJ-1.png
new file mode 100644
index 0000000..acf7869
Binary files /dev/null and b/vignettes/figs/make_NJ-1.png differ
diff --git a/vignettes/figs/plotgroves-1.png b/vignettes/figs/plotgroves-1.png
new file mode 100644
index 0000000..52509dc
Binary files /dev/null and b/vignettes/figs/plotgroves-1.png differ
diff --git a/vignettes/figs/plotgroves2_readme-1.png b/vignettes/figs/plotgroves2_readme-1.png
new file mode 100644
index 0000000..2f63bda
Binary files /dev/null and b/vignettes/figs/plotgroves2_readme-1.png differ
diff --git a/vignettes/figs/plotgroves2_readme-2.png b/vignettes/figs/plotgroves2_readme-2.png
new file mode 100644
index 0000000..8ce083a
Binary files /dev/null and b/vignettes/figs/plotgroves2_readme-2.png differ
diff --git a/vignettes/figs/plotgroves2_readme-3.png b/vignettes/figs/plotgroves2_readme-3.png
new file mode 100644
index 0000000..daaaa41
Binary files /dev/null and b/vignettes/figs/plotgroves2_readme-3.png differ
diff --git a/vignettes/figs/plotgroves_readme-1.png b/vignettes/figs/plotgroves_readme-1.png
new file mode 100644
index 0000000..e28fd47
Binary files /dev/null and b/vignettes/figs/plotgroves_readme-1.png differ
diff --git a/vignettes/figs/scree_plot-1.png b/vignettes/figs/scree_plot-1.png
new file mode 100644
index 0000000..a889026
Binary files /dev/null and b/vignettes/figs/scree_plot-1.png differ
diff --git a/vignettes/figs/see_ML_boots-1.png b/vignettes/figs/see_ML_boots-1.png
new file mode 100644
index 0000000..803789b
Binary files /dev/null and b/vignettes/figs/see_ML_boots-1.png differ
diff --git a/vignettes/figs/see_NJ_boots-1.png b/vignettes/figs/see_NJ_boots-1.png
new file mode 100644
index 0000000..7796707
Binary files /dev/null and b/vignettes/figs/see_NJ_boots-1.png differ
diff --git a/vignettes/figs/trees2_and_3-1.png b/vignettes/figs/trees2_and_3-1.png
new file mode 100644
index 0000000..351feca
Binary files /dev/null and b/vignettes/figs/trees2_and_3-1.png differ
diff --git a/vignettes/figs/trees2_and_3-2.png b/vignettes/figs/trees2_and_3-2.png
new file mode 100644
index 0000000..86c9327
Binary files /dev/null and b/vignettes/figs/trees2_and_3-2.png differ
diff --git a/vignettes/figs/treespace3d.png b/vignettes/figs/treespace3d.png
new file mode 100644
index 0000000..5f8e036
Binary files /dev/null and b/vignettes/figs/treespace3d.png differ
diff --git a/vignettes/figs/treespaceDensiTree.png b/vignettes/figs/treespaceDensiTree.png
new file mode 100644
index 0000000..82339a9
Binary files /dev/null and b/vignettes/figs/treespaceDensiTree.png differ
diff --git a/vignettes/figs/treespaceTree.png b/vignettes/figs/treespaceTree.png
new file mode 100644
index 0000000..0257268
Binary files /dev/null and b/vignettes/figs/treespaceTree.png differ
diff --git a/vignettes/figs/view_ML-1.png b/vignettes/figs/view_ML-1.png
new file mode 100644
index 0000000..0113158
Binary files /dev/null and b/vignettes/figs/view_ML-1.png differ
diff --git a/vignettes/figs/wiwMedTreePlot-1.png b/vignettes/figs/wiwMedTreePlot-1.png
new file mode 100644
index 0000000..1b96cd7
Binary files /dev/null and b/vignettes/figs/wiwMedTreePlot-1.png differ
diff --git a/vignettes/figs/wiw_MDS1000-1.png b/vignettes/figs/wiw_MDS1000-1.png
new file mode 100644
index 0000000..7e982ec
Binary files /dev/null and b/vignettes/figs/wiw_MDS1000-1.png differ
diff --git a/vignettes/figs/woodmice-tip-emphasis_readme-1.png b/vignettes/figs/woodmice-tip-emphasis_readme-1.png
new file mode 100644
index 0000000..5a3c57e
Binary files /dev/null and b/vignettes/figs/woodmice-tip-emphasis_readme-1.png differ
diff --git a/vignettes/figs/woodmiceCluster1-1.png b/vignettes/figs/woodmiceCluster1-1.png
new file mode 100644
index 0000000..45b5aaf
Binary files /dev/null and b/vignettes/figs/woodmiceCluster1-1.png differ
diff --git a/vignettes/figs/woodmiceCluster1_readme-1.png b/vignettes/figs/woodmiceCluster1_readme-1.png
new file mode 100644
index 0000000..590dc1e
Binary files /dev/null and b/vignettes/figs/woodmiceCluster1_readme-1.png differ
diff --git a/vignettes/figs/woodmiceMedian-1.png b/vignettes/figs/woodmiceMedian-1.png
new file mode 100644
index 0000000..0143f5f
Binary files /dev/null and b/vignettes/figs/woodmiceMedian-1.png differ
diff --git a/vignettes/figs/woodmiceMedian_readme-1.png b/vignettes/figs/woodmiceMedian_readme-1.png
new file mode 100644
index 0000000..791ce10
Binary files /dev/null and b/vignettes/figs/woodmiceMedian_readme-1.png differ
diff --git a/vignettes/figs/woodmicePlots_readme-1.png b/vignettes/figs/woodmicePlots_readme-1.png
new file mode 100644
index 0000000..e29495d
Binary files /dev/null and b/vignettes/figs/woodmicePlots_readme-1.png differ
diff --git a/vignettes/figs/woodmicePlots_readme-2.png b/vignettes/figs/woodmicePlots_readme-2.png
new file mode 100644
index 0000000..7ca256d
Binary files /dev/null and b/vignettes/figs/woodmicePlots_readme-2.png differ
diff --git a/vignettes/figs/woodmicePlots_readme-3.png b/vignettes/figs/woodmicePlots_readme-3.png
new file mode 100644
index 0000000..06ffefa
Binary files /dev/null and b/vignettes/figs/woodmicePlots_readme-3.png differ
diff --git a/vignettes/figs/woodmice_plotTreeDiff-1.png b/vignettes/figs/woodmice_plotTreeDiff-1.png
new file mode 100644
index 0000000..bce2a34
Binary files /dev/null and b/vignettes/figs/woodmice_plotTreeDiff-1.png differ
diff --git a/vignettes/figs/woodmice_plotTreeDiff-2.png b/vignettes/figs/woodmice_plotTreeDiff-2.png
new file mode 100644
index 0000000..1fafd37
Binary files /dev/null and b/vignettes/figs/woodmice_plotTreeDiff-2.png differ
diff --git a/vignettes/figs/woodmice_plotTreeDiff_readme-1.png b/vignettes/figs/woodmice_plotTreeDiff_readme-1.png
new file mode 100644
index 0000000..b6105b0
Binary files /dev/null and b/vignettes/figs/woodmice_plotTreeDiff_readme-1.png differ
diff --git a/vignettes/figs/woodmice_plotTreeDiff_readme-2.png b/vignettes/figs/woodmice_plotTreeDiff_readme-2.png
new file mode 100644
index 0000000..9ffa856
Binary files /dev/null and b/vignettes/figs/woodmice_plotTreeDiff_readme-2.png differ
diff --git a/vignettes/introduction.Rmd b/vignettes/introduction.Rmd
new file mode 100644
index 0000000..79dc296
--- /dev/null
+++ b/vignettes/introduction.Rmd
@@ -0,0 +1,395 @@
+---
+title: "Exploration of landscapes of phylogenetic trees"
+author: "Thibaut Jombart, Michelle Kendall"
+date: "`r Sys.Date()`"
+output: rmarkdown::html_vignette
+vignette: >
+ %\VignetteEngine{knitr::rmarkdown}
+ %\VignetteIndexEntry{treespace: exploration of landscapes of phylogenetic trees}
+ \usepackage[utf8]{inputenc}
+---
+
+
+```{r setup, echo=FALSE}
+# set global chunk options: images will be 7x5 inches
+knitr::opts_chunk$set(fig.width=7, fig.height=7, fig.path="figs/", cache=FALSE)
+options(digits = 4)
+library("rgl")
+knitr::knit_hooks$set(webgl=hook_webgl)
+```
+
+*treespace* implements new methods for the exploration and analysis of distributions of phylogenetic trees for a given set of taxa.
+
+
+Installing *treespace*
+-------------
+To install the development version from github:
+```{r install, eval=FALSE}
+library(devtools)
+install_github("thibautjombart/treespace")
+```
+
+The stable version can be installed from CRAN using:
+```{r install2, eval=FALSE}
+install.packages("treespace")
+```
+
+Then, to load the package, use:
+```{r load}
+library("treespace")
+```
+
+
+Content overview
+-------------
+The main functions implemented in *treespace* are:
+
+* __`treespace`__: explore landscapes of phylogenetic trees
+
+* __`treespaceServer`__: open up an application in a web browser
+for an interactive exploration of the diversity in a set of trees
+
+* __`findGroves`__: identify clusters of similar trees
+
+* __`plotGroves`__: scatterplot of groups of trees, and __`plotGrovesD3`__ which enables interactive plotting based on d3.js
+
+* __`medTree`__: find geometric median tree(s) to summarise a group of trees
+
+Other functions are central to the computations of distances between trees:
+
+* __`treeVec`__: characterise a tree by a vector
+
+* __`treeDist`__: find the distance between two tree vectors
+
+* __`multiDist`__: find the pairwise distances of a list of trees
+
+* __`refTreeDist`__: find the distances of a list of trees from a reference tree
+
+* __`tipDiff`__: for a pair of trees, list the tips with differing ancestry
+
+* __`plotTreeDiff`__: plot a pair of trees, highlighting the tips with differing ancestry
+
+
+Distributed datasets include:
+
+* __`woodmiceTrees`__: illustrative set of 201 trees built using the neighbour-joining and bootstrapping example from the woodmice dataset in the ape documentation.
+
+* __`DengueTrees`__: 500 trees sampled from a BEAST posterior set of trees from (Drummond and Rambaut, 2007)
+
+* __`DengueSeqs`__: 17 dengue virus serotype 4 sequences from (Lanciotti *et al*., 1997), from which the `DengueTrees` were inferred.
+
+* __`DengueBEASTMCC`__: the maximum clade credibility (MCC) tree from the `DengueTrees`.
+
+
+
+Exploring trees with *treespace*
+--------------
+
+We first load *treespace*, and the packages required for graphics:
+```{r load_packages, message=FALSE, warning=FALSE}
+library("treespace")
+library("adegenet")
+library("adegraphics")
+library("rgl")
+```
+
+The function `treespace` defines typologies of phylogenetic trees using a two-step approach:
+
+1. perform pairwise comparisons of trees using various (Euclidean) metrics; by default, the comparison uses the Kendall and Colijn metric (Kendall and Colijn, 2016) which is described in more detail below; other metrics rely on tip distances implemented in *adephylo* (Jombart *et al.*, 2010) and *phangorn* (Schliep 2011).
+
+2. use Metric Multidimensional Scaling (MDS, aka Principal Coordinates Analysis, PCoA) to summarise pairwise distances between the trees as well as possible into a few dimensions; the output of the MDS is typically visualised using scatterplots of the first few Principal Components (PCs); this step relies on the PCoA implemented in *ade4* (Dray and Dufour, 2007).
+
+The function `treespace` performs both tasks, returning both the matrix of pairwise tree comparisons (`$D`), and the PCoA (`$pco`).
+This can be illustrated using randomly generated trees:
+```{r treespace}
+# generate list of trees
+set.seed(1)
+x <- rmtree(10, 20)
+names(x) <- paste("tree", 1:10, sep = "")
+
+# use treespace
+res <- treespace(x, nf=3)
+names(res)
+res
+```
+
+Pairwise tree distances can be visualised using *adegraphics*:
+```{r distances}
+# table.image
+table.image(res$D, nclass=30)
+
+# table.value with some customization
+table.value(res$D, nclass=5, method="color",
+ symbol="circle", col=redpal(5))
+
+```
+
+The best representation of these distances in a 2-dimensional space is given by the first 2 PCs of the MDS.
+These can be visualised using any scatter plotting tool; here we use the *treespace* function `plotGroves`, based on the *adegraphics* function `scatter`:
+
+```{r plotgroves}
+plotGroves(res$pco, lab.show=TRUE, lab.cex=1.5)
+```
+
+Alternatively, `plotGrovesD3` creates interactive plots based on d3.js:
+
+```{r plotgrovesD3}
+plotGrovesD3(res$pco, treeNames=1:10)
+```
+Tree labels can be dragged into new positions to avoid problems such as overlapping.
+
+The functionality of `treespace` can be further illustrated using *ape*'s dataset *woodmouse*, from which we built the 201 trees supplied in `woodmiceTrees` using the neighbour-joining and bootstrapping example from the *ape* documentation.
+```{r woodmicePlots}
+data(woodmiceTrees)
+wm.res <- treespace(woodmiceTrees,nf=3)
+
+# PCs are stored in:
+head(wm.res$pco$li)
+
+# plot results
+plotGrovesD3(wm.res$pco)
+```
+
+Packages such as *adegraphics* and *ggplot2* can be used to make alternative plots, for example visualising the density of points within the space.
+
+The *treespace* function `multiDist` simply performs the pairwise comparison of trees and outputs a distance matrix.
+This function may be preferable for large datasets, and when principal co-ordinate analysis is not required.
+It includes an option to save memory at the expense of computation time.
+
+
+
+
+Identifying clusters of trees
+--------------
+Once a typology of trees has been derived using the approach described above, one may want to formally identify clusters of similar trees.
+One simple approach is:
+
+1. select a few first PCs of the MDS (retaining signal but getting rid of random noise)
+
+2. derive pairwise Euclidean distances between trees based on these PCs
+
+3. use hierarchical clustering to obtain a dendrogram of these trees
+
+4. cut the dendrogram to obtain clusters
+
+In *treespace*, the function `findGroves` implements this approach, offering various clustering options (see `?findGroves`). Here we supply the function with our `treespace` output `wm.res` since we have already calculated it, but it is also possible to skip the steps above and directly supply `findGroves` with a multiPhylo list of trees.
+```{r findgroves, cache=FALSE}
+wm.groves <- findGroves(wm.res, nclust=6)
+names(wm.groves)
+```
+Note that when the number of clusters (`nclust`) is not provided, the function will display a dendrogram and ask for a cut-off height.
+
+The results can be plotted directly using `plotGrovesD3` (see `?plotGrovesD3` for options):
+```{r plotgroves2}
+# basic plot
+plotGrovesD3(wm.groves)
+
+# alternative with improved legend and tooltip text, giving the tree numbers:
+plotGrovesD3(wm.groves, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+
+# plot axes 2 and 3. This helps to show why, for example, clusters 2 and 4 have been identified as separate, despite them appearing to overlap when viewing axes 1 and 2.
+plotGrovesD3(wm.groves, xax=2, yax=3, tooltip_text=paste0("Tree ",1:201), legend_width=50, col_lab="Cluster")
+```
+
+We can also plot in 3D:
+```{r plotgroves_3D, rgl=TRUE, webgl=TRUE}
+# prepare a colour palette:
+colours <- fac2col(wm.groves$groups, col.pal=funky)
+plot3d(wm.groves$treespace$pco$li[,1],
+ wm.groves$treespace$pco$li[,2],
+ wm.groves$treespace$pco$li[,3],
+ col=colours, type="s", size=1.5,
+ xlab="", ylab="", zlab="")
+```
+
+
+`treespaceServer`: a web application for *treespace*
+--------------
+The functionalities of `treespace` are also available via a user-friendly web interface, running locally on the default web browser.
+It can be started by simply typing `treespaceServer()`.
+The interface allows you to import trees and run `treespace` to view and explore the tree space in 2 or 3 dimensions.
+It is then straightforward to analyse the tree space by varying $\lambda$, looking for clusters using `findGroves` and saving results in various formats.
+Individual trees can be easily viewed, including median trees per cluster (see below). Pairs of trees can be viewed together with their tip-differences highlighted using the function `plotTreeDiff`, and collections of trees can be seen together using `densiTree` from the package *phangorn*.
+It is fully documented in the *help* tab.
+
+
+```{r shiny_figures, echo=FALSE, out.width="650px", fig.retina = NULL}
+knitr::include_graphics("figs/treespace3d.png")
+
+knitr::include_graphics("figs/treespaceTree.png")
+
+knitr::include_graphics("figs/treespaceDensiTree.png")
+```
+
+
+
+
+
+Finding median trees
+--------------
+
+When a set of trees have very similar structures, it makes sense to summarize them into a single 'consensus' tree.
+In `treespace`, this is achieved by finding the *median tree* for a set of trees according to the Kendall and Colijn metric.
+That is, we find the tree which is closest to the centre of the set of trees in the tree landscape defined in `treespace`.
+This procedure is implemented by the function `medTree`:
+
+```{r woodmiceMedian}
+# get first median tree
+tre <- medTree(woodmiceTrees)$trees[[1]]
+
+# plot tree
+plot(tre,type="cladogram",edge.width=3, cex=0.8)
+```
+
+However, a more complete and accurate summary of the data can be given by finding a summary tree from each cluster.
+This is achieved using the `groups` argument of `medTree`:
+```{r woodmiceCluster1, out.width="600px"}
+# find median trees for the 6 clusters identified earlier:
+res <- medTree(woodmiceTrees, wm.groves$groups)
+
+# there is one output per cluster
+names(res)
+
+# get the first median of each
+med.trees <- lapply(res, function(e) ladderize(e$trees[[1]]))
+
+# plot trees
+par(mfrow=c(2,3))
+for(i in 1:length(med.trees)) plot(med.trees[[i]], main=paste("cluster",i),cex=1.5)
+
+```
+
+These trees exhibit a number of topological differences, e.g. in the placement of the **(1007S,1208S,0909S)** clade.
+To examine the differences between the trees in a pairwise manner, we can use the function `plotTreeDiff`, for example:
+
+```{r woodmice_plotTreeDiff}
+# Compare median trees from clusters 1 and 2:
+plotTreeDiff(med.trees[[1]],med.trees[[2]], use.edge.length=FALSE)
+# Compare median trees from clusters 1 and 4, and change aesthetics:
+plotTreeDiff(med.trees[[1]],med.trees[[4]], type="cladogram", use.edge.length=FALSE, edge.width=2, colourMethod="palette",palette=spectral)
+```
+
+Performing this analysis enables the detection of distinct representative trees supported by data.
+
+Note that in this example we supplied the function `medTree` with the multiPhylo list of trees. A more computationally efficient process (at the expense of using more memory) is to use the option `return.tree.vectors` in the initial `treespace` call, and then supply these vectors directly to `medTree`.
+In this case, the tree indices are returned by `medTree` but the trees are not (since they were not supplied).
+
+Emphasising the placement of certain tips or clades
+--------------
+
+In some analyses it may be informative to emphasise the placement of particular tips or clades within a set of trees. This can be particularly useful in large trees where the study is focused on a smaller clade. Priority can be given to a list of tips using the argument `emphasise.tips`, whose corresponding values in the vector comparison will be given a weight of `emphasise.weight` times the others (the default is 2, i.e. twice the weight).
+
+For example, if we wanted to emphasise where the woodmice trees agree and disagree on the placement of the **(1007S,1208S,0909S)** clade, we can simply emphasise that clade as follows:
+```{r woodmice-tip-emphasis}
+wm3.res <- treespace(woodmiceTrees,nf=2,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+
+# plot results
+plotGrovesD3(wm3.res$pco)
+```
+
+It can be seen from the scale of the plot and the density of clustering that the trees are now separated into more distinct clusters.
+```{r findgroves-with-emphasis}
+wm3.groves <- findGroves(woodmiceTrees,nf=3,nclust=6,emphasise.tips=c("No1007S","No1208S","No0909S"),emphasise.weight=3)
+plotGrovesD3(wm3.groves)
+```
+
+Conversely, where the structure of a particular clade is not of interest (for example, lineages within an outgroup which was only included for rooting purposes), those tips can be given a weight less than 1 so as to give them less emphasis in the comparison. We note that although it is possible to give tips a weighting of 0, we advise caution with this as the underlying function will no longer be guaranteed to be a metric. That is, a distance of 0 between two trees will no longer necessa [...]
+
+Method: characterising a tree by a vector
+--------------
+Kendall and Colijn proposed a [metric](http://dx.doi.org/10.1093/molbev/msw124) for comparing rooted phylogenetic trees (Kendall and COlijn, 2016). Each tree is characterised by a vector which notes the placement of the most recent common ancestor (MRCA) of each pair of tips, as demonstrated in this example:
+
+```{r figure_construction, echo=FALSE, out.width="650px", fig.retina = NULL}
+knitr::include_graphics("figs/construction.png")
+```
+
+Specifically, it records the distance between the MRCA of a pair of tips $(i,j)$ and the root in two ways: the number of edges $m_{i,j}$, and the path length $M_{i,j}$. It also records the length $p_i$ of each 'pendant' edge between a tip $i$ and its immediate ancestor. This procedure results in two vectors for a tree $T$:
+
+$$
+m(T) = (m_{1,2}, m_{1,3},...,m_{k-1,k},1,...,1)
+$$
+
+and
+
+$$
+M(T) = (M_{1,2}, M_{1,3},...,M_{k-1,k},p_1,...,p_k).
+$$
+
+In $m(T)$ we record the pendant lengths as 1, as each tip is 1 step from its immediate ancestor. We combine $m$ and $M$ with a parameter $\lambda$ between zero and one to weight the contribution of branch lengths, characterising each tree with a vector
+
+$$
+v_\lambda(T) = (1-\lambda)m(T) + \lambda M(T).
+$$
+
+This is implemented as the function __`treeVec`__. For example,
+```{r treevec}
+# generate a random tree:
+tree <- rtree(6)
+# topological vector of mrca distances from root:
+treeVec(tree)
+# vector of mrca distances from root when lambda=0.5:
+treeVec(tree,0.5)
+# vector of mrca distances as a function of lambda:
+vecAsFunction <- treeVec(tree,return.lambda.function=TRUE)
+# evaluate the vector at lambda=0.5:
+vecAsFunction(0.5)
+```
+
+The metric -- the distance between two trees -- is the Euclidean distance between these vectors:
+
+$$
+d_\lambda(T_a, T_b) = || v_\lambda(T_a) - v_\lambda(T_b) ||.
+$$
+
+This can be found using __`treeDist`__:
+```{r treedist}
+# generate random trees
+tree_a <- rtree(6)
+tree_b <- rtree(6)
+
+# topological (lambda=0) distance:
+treeDist(tree_a,tree_b)
+
+# branch-length focused (lambda=1) distance:
+treeDist(tree_a,tree_b,1)
+```
+
+
+
+References
+--------------
+
+* Dray, S. and Dufour, A. B. (2007) The ade4 package: implementing the duality diagram for ecologists. Journal of Statistical Software 22(4): 1-20.
+
+* Drummond, A. J. and Rambaut, A. (2007)
+BEAST: Bayesian evolutionary analysis by sampling trees.
+BMC Evolutionary Biology, 7(1), 214.
+
+* Jombart, T., Balloux, F. and Dray, S. (2010) adephylo: new tools for investigating the phylogenetic signal in biological traits. Bioinformatics 26: 1907-1909. DOI: 10.1093/bioinformatics/btq292
+
+* Kendall, M. and Colijn, C. (2016) Mapping phylogenetic trees to reveal distinct patterns of evolution. Molecular Biology and Evolution, first published online: June 24, 2016. DOI: 10.1093/molbev/msw124
+
+* Lanciotti, R. S., Gubler, D. J. and Trent, D. W. (1997)
+Molecular evolution and phylogeny of dengue-4 viruses.
+Journal of General Virology, 78(9), 2279-2286.
+
+* Schliep, K. P. (2011) phangorn: phylogenetic analysis in R. Bioinformatics 27(4): 592-593.
+
+
+Authors / Contributors
+--------------
+Authors:
+
+* [Thibaut Jombart](https://sites.google.com/site/thibautjombart/)
+
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
+
+Contributors:
+
+* [Jacob Almagro-Garcia](http://www.well.ox.ac.uk/jacob-almagro-garcia)
+
+* [Caroline Colijn](http://www.imperial.ac.uk/people/c.colijn)
+
+Maintainer of the CRAN version:
+
+* [Michelle Kendall](http://www.imperial.ac.uk/people/m.kendall)
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-treespace.git
More information about the debian-med-commit
mailing list