File: TransmissionTreesVignette.R

package info (click to toggle)
r-cran-treespace 1.1.3%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 2,544 kB
  • sloc: cpp: 24; sh: 13; makefile: 2
file content (132 lines) | stat: -rw-r--r-- 4,802 bytes parent folder | download
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
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[[1]]]])
plot(medgraph)