Commit 8cef877d authored by Kunst, Jonathan's avatar Kunst, Jonathan
Browse files

More testing on plotly

parent b35e5fab
library(polyqtlR)
library(plotly)
library(tidyverse)
data("phased_maplist.4x", "SNP_dosages.4x", "Phenotypes_4x")
# IBD estimation
......@@ -8,6 +10,12 @@ IBD_4x <- estimate_IBD(phased_maplist = phased_maplist.4x,
bivalent_decoding = TRUE,
ncores = 2)
names(IBD_4x)
IBD_4x[['LG1']]
test <- 1:length(IBD_4x)
which(names(IBD_4x) == 'LG2')
# haplo visualisation
vis_hap <- visualiseHaplo(IBD_list = IBD_4x,
display_by = "name",
......@@ -41,6 +49,65 @@ plotQTL(LOD_data = qtl_LODs.4x,
plotLinearQTL(LOD_data = qtl_LODs.4x,
col = "dodgerblue")
# plotly example
dfs <- qtl_LODs.4x$QTL.res %>%
nest_by(chromosome)
lapply(seq_along(dfs$data), function(i){
plot_ly(dfs$data[[i]], x = ~position, y = ~LOD, type = 'scatter', mode = 'lines') %>%
layout(yaxis = list(title = 'Logarithm of Odds (LOD)', showgrid = FALSE),
xaxis = list(title = str(i), showgrid = FALSE))
}) %>%
subplot(., shareX = FALSE, shareY = TRUE, titleX = TRUE)
panel <- . %>%
plot_ly(x = ~position, y = ~LOD) %>%
add_lines() %>%
add_annotations(
text = ~unique(chromosome),
x = 0.5,
y = 0,
yref = "paper",
xref = "paper",
yanchor = "bottom",
xanchor = 'center',
yshift = -35,
showarrow = FALSE,
font = list(size = 15)
) %>%
layout(
showlegend = TRUE,
shapes = list(
type = "rect",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = 0,
y1 = 0,
yanchor = 'center',
yref = "paper",
ysizemode = "pixel",
fillcolor = toRGB("gray80"),
line = list(color = "transparent")
),
xaxis = list(showgrid = FALSE),
yaxis = list(showgrid = FALSE)
)
qtl_LODs.4x$QTL.res %>%
mutate(chromosome = paste('Linkage Group', chromosome)) %>%
group_by(chromosome) %>%
do(p = panel(.)) %>%
subplot(nrows = 1, shareX = FALSE, shareY = TRUE)
plot_ly(qtl_LODs.4x$QTL.res,
x = ~position,
y = ~LOD)
# sig thresholds with permutation tests
qtl_LODs.4x <- QTLscan(IBD_list = IBD_4x,
Phenotype.df = Phenotypes_4x,
......@@ -66,3 +133,166 @@ qtl_LODs.4x_cofactor <- QTLscan(IBD_list = IBD_4x,
"cM" = 12.3),
perm_test = FALSE,
ncores = 2)#nc is the number of cores, defined earlier
# plotly ----
data("diamonds", package = 'ggplot2')
diamonds
plot_ly(diamonds, x = ~cut)
plot_ly(diamonds, x = ~cut, y = ~clarity)
plot_ly(diamonds, x = ~cut, y = ~clarity, colors = "Accent")
# plotly uses purely functional programming style
# input -> function modifies -> modified output
# layout expect a plot_ly object and modifies it according to function call
layout(plot_ly(diamonds, x = ~cut),
title = 'beautiful histogram')
# above code is less readable than
diamonds %>%
plot_ly(x = ~cut) %>%
layout(title = 'beautiful histogram')
# we can control layout even more by using add_* (i.e. add_histogram)
diamonds %>%
plot_ly() %>%
add_histogram(x = ~cut)
# or with bars where you need to calculate the statistics beforehand
diamonds %>%
count(cut) %>%
plot_ly() %>%
add_bars( x = ~cut, y = ~n)
# non-statistical layers (i.e. bars) are faster and more responsive but less flexible client-side
# another example of:
# - globally assigning x to cut
# - modify data after histogram is plotted
# - add another layer of text from modified summarised data
# note: make sure you want to display this information on the same axes
diamonds %>%
plot_ly(x = ~cut) %>%
add_histogram() %>%
group_by(cut) %>%
summarise(n = n()) %>%
add_text(
text = ~scales::comma(n), y = ~n,
textposition = "top middle",
cliponaxis = FALSE
)
# underlying plot_ly() is the json code which is captured in a list in plotly_build()
plot <- plot_ly(diamonds, x = ~cut, color = ~clarity, colors = "Accent")
# the underlying json
plotly_json(plot)
# the json figure contains data (traces) and layout
# a trace defines mapping from data and visuals
# every trace has a type and determines attributes
# using plotly_build we can debug a plot
b_plot <- plotly_build(plot)
length(b_plot$x$data)
# extract name of each trace (8 traces for 8 clarities) appearing in the figure definition x in data
map_chr(b_plot$x$data, "name")
length(unique(diamonds$clarity))
# the colors of the clarity are not directly coded in the json list
# instead plotly_build() designates colors with marker.color
m <- lm(log(price) ~ log(carat), data = diamonds)
diamonds <- modelr::add_residuals(diamonds, m)
diamonds <- modelr::add_predictions(diamonds, m)
head(diamonds)
# qtl LOD plot two models example ----
lodsmod1 <- qtl_LODs.4x$QTL.res %>%
dplyr::mutate(model = 'model1')
lodsmod2 <- lodsmod1 %>%
mutate(model = 'model2',
LOD = jitter(LOD, 1, 0.25),
.keep = 'unused')
lodsmod <- rbind(lodsmod1, lodsmod2)
p <- ggplot(lodsmod, aes(x = position, y = LOD, color = model)) +
geom_line() +
facet_grid(~chromosome,
switch = 'x',
space = 'free_x') +
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
strip.background = element_blank(),
strip.placement = 'outside'
)
gp <- ggplotly(p) %>%
layout(title = list(text = 'Chromosome', xanchor = 'center'))
gp
# qtl LOD plot firstexample ----
dfs <- qtl_LODs.4x$QTL.res %>%
nest_by(chromosome)
lapply(seq_along(dfs$data), function(i){
plot_ly(dfs$data[[i]], x = ~position, y = ~LOD, type = 'scatter', mode = 'lines') %>%
layout(yaxis = list(title = 'Logarithm of Odds (LOD)', showgrid = FALSE),
xaxis = list(title = str(i), showgrid = FALSE))
}) %>%
subplot(., shareX = FALSE, shareY = TRUE, titleX = TRUE)
panel <- . %>%
plot_ly(x = ~position, y = ~LOD) %>%
add_lines() %>%
add_annotations(
text = ~unique(chromosome),
x = 0.5,
y = 0,
yref = "paper",
xref = "paper",
yanchor = "bottom",
xanchor = 'center',
yshift = -35,
showarrow = FALSE,
font = list(size = 15)
) %>%
layout(
showlegend = TRUE,
shapes = list(
type = "rect",
x0 = 0,
x1 = 1,
xref = "paper",
y0 = 0,
y1 = 0,
yanchor = 'center',
yref = "paper",
ysizemode = "pixel",
fillcolor = toRGB("gray80"),
line = list(color = "transparent")
),
xaxis = list(showgrid = FALSE),
yaxis = list(showgrid = FALSE)
)
qtl_LODs.4x$QTL.res %>%
mutate(chromosome = paste('Linkage Group', chromosome)) %>%
group_by(chromosome) %>%
do(p = panel(.)) %>%
subplot(nrows = 1, shareX = FALSE, shareY = TRUE)
plot_ly(qtl_LODs.4x$QTL.res,
x = ~position,
y = ~LOD)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment