-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathtrees.Rmd
131 lines (102 loc) · 5.44 KB
/
trees.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
Below is an interactive visualization of a subsampled phylogenetic snapshot of SARS-CoV-2 genomes from Canada. Please see methods for details.
The x-axis of the time tree represents the estimated number of years from today for which the root emerged. The x-axis of the diversity trees shows the number of mutations from the outgroup.
Hovering over a node will display a tool tip with sequence metadata, clicking on a node with the tooltip shown will copy the isolate ID to your clipboard.
```{r message=FALSE}
### metadata and trees
source("scripts/tree.r")
# load trees from files
mltree <- read.tree(paste0(params$datadir,"/aligned_nonrecombinant_sample1.rtt.nwk"))
ttree <- read.tree(paste0(params$datadir,"/aligned_nonrecombinant_sample1.timetree.nwk"))
recombTTree <- read.tree(paste0(params$datadir,"/aligned_recombinant_X_sample1.timetree.nwk"))
recombMLree <- read.tree(paste0(params$datadir,"/aligned_recombinant_X_sample1.rtt.nwk"))
#stopifnot(all(sort(mltree$tip.label) == sort(ttree$tip.label)))
dateseq <- seq(ymd('2019-12-01'), ymd('2022-12-01'), by='3 month')
# tips are labeled with [fasta name]_[lineage]_[coldate]
# extracting just the first part makes it easier to link to metadata
mltree$tip.label <- reduce.tipnames(mltree$tip.label)
ttree$tip.label <- reduce.tipnames(ttree$tip.label)
recombTTree$tip.label <- reduce.tipnames(recombTTree$tip.label)
fieldnames<- c("fasta_header_name", "province", "host_gender", "host_age_bin",
"sample_collected_by", "purpose_of_sampling",
"lineage", "pango_group","week", "GID")
# extract rows from metadata table that correspond to ttree
metasub1 <- meta[meta$fasta_header_name%in% ttree$tip.label, fieldnames]
# sort rows to match tip labels in tree
metasub1 <- metasub1[match(ttree$tip.label, metasub1$fasta_header_name), ]
#omi tree metadata
#metasub_omi <- metasub1[grepl("Omicron",metasub1$pango_group ), ]
#recomb tree metadata
mmetasub_recomb <- meta[meta$fasta_header_name%in% recombTTree$tip.label, fieldnames]
mmetasub_recomb <- mmetasub_recomb[match(recombTTree$tip.label, mmetasub_recomb$fasta_header_name), ]
#scale to number of mutations
mltree$edge.length <- mltree$edge.length*29903
mltree <- ladderize(mltree, FALSE)
recombMLree$edge.length <- recombMLree$edge.length*29903
recombMLree <- ladderize(recombMLree, FALSE)
#enforce a non zero branch length so lines can be drawn in javascript
###Time Tree
ttree$edge.length[ttree$edge.length == 0] <- 1e-4
#ttree <- ladderize(ttree, FALSE)
recombTTree$edge.length[recombTTree$edge.length == 0] <- 1e-4
#recombTTree <- ladderize(recombTTree, FALSE)
hab=unique(meta$host_age_bin)
hab=hab[order(hab)]
months=unique(meta$month)
months=as.character(months[order(months)])
weeks=unique(meta$week)
weeks=as.character(weeks[order(weeks)])
presetColors=data.frame(name=c("other",
VOCVOI$name,
hab,
months,
weeks),
color=c("#777777",
VOCVOI$color,
rev(hcl.colors(length(hab)-1, "Berlin")),"#777777",
hcl.colors(length(months), "Berlin"),
hcl.colors(length(weeks), "Berlin")
))
#suppressWarnings({
# res <- ace(metasub1$pango.group, ttree2, type="discrete", model="ER")
#})
#idx <- apply(res$lik.anc, 1, which.max)[2:nrow(res$lik.anc)] # exclude root edge
#anc <- levels(as.factor(metasub1$pango.group))[idx]
source("scripts/tree.r")
timeTreeJsonObj <- DrawTree(ttree, metasub1, "timetree", presetColors, fieldnames=fieldnames)
recombTimeTreeJsonObj <- DrawTree(recombTTree, mmetasub_recomb, "recombtimetree", presetColors, "lineage", fieldnames= fieldnames)
#diversity ML tree
diversityTreeJsonObj <- DrawTree(mltree, metasub1, "mltree", presetColors, fieldnames=fieldnames)
recombDiversityTreeJsonObj <- DrawTree(recombMLree, mmetasub_recomb, "recombmltree", presetColors, "lineage", fieldnames=fieldnames)
#write(recombDiversityTreeJsonObj, "downloads/test.json")
### omicron diversity tree
#MLtree_omi<-keep.tip(mltree, metasub_omi$fasta_header_name)
#OmicrondiversityTreeJsonObj <- DrawTree(MLtree_omi, metasub_omi, "omimltree", presetColors, fieldnames=fieldnames)
```
## Time Tree {.active}
```{r message=FALSE, echo = FALSE, fig.width=8, fig.height=6}
r2d3(data=timeTreeJsonObj,
script="js/tree.js", container="div", elementId="ttree-element")
```
## XBB* time tree
```{r message=FALSE, echo = FALSE, fig.width=8, fig.height=6}
r2d3(data=recombTimeTreeJsonObj,
script="js/tree.js", container="div", elementId="recombttree-element")
```
## Diversity Tree
```{r message=FALSE, echo = FALSE, fig.width=8, fig.height=6}
r2d3(data=diversityTreeJsonObj,
script="js/tree.js", container="div", elementId="mltree-element")
```
<!-- ## Omicron Diversity Tree -->
<!-- ```{r message=FALSE, echo = FALSE, fig.width=8, fig.height=6} -->
<!-- r2d3(data=OmicrondiversityTreeJsonObj, -->
<!-- script="js/tree.js", container="div", elementId="omimltree-element") -->
<!-- ``` -->
## XBB* Diversity tree
```{r message=FALSE, echo = FALSE, fig.width=8, fig.height=6}
r2d3(data=recombDiversityTreeJsonObj,
script="js/tree.js", container="div", elementId="recombmltree-element")
```
## {-}
<hr style="border:1px solid gray">
##