Commit 9594d6a9 authored by NAVRATIL VINCENT's avatar NAVRATIL VINCENT
Browse files

add dginn summary raw

parent 8f5dcb5a
......@@ -2,4 +2,5 @@ library(shinythemes)
library(shiny)
library(ggtree)
library(ggplot2)
library(gridExtra)
dginn_msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL, dginn_position=NULL, bg_line = TRUE, height = 0.8){
dginn_msaplot <- function(p, fasta,dginn_position=NULL, offset=0, width=1, color=NULL, window=NULL, bg_line = TRUE, height = 0.8){
if (missingArg(fasta)) {
x <- NULL
} else if (is(fasta, "DNAbin") || is(fasta, "AAbin") ) {
......@@ -36,8 +36,9 @@ dginn_msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL,
seqs <- lapply(1:nrow(x), function(i) {
seq <- as.vector(as.character(x[i,]))
seq[seq %in% c('a','t','g','c','*')] <- 'MSA'
seq[dginn_position] <- 'PSS'
#seq[dginn_position*3] <- 'PSS'
seq[! seq %in% c('PSS','MSA')] <- '-'
return(seq)
})
......@@ -52,10 +53,10 @@ dginn_msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL,
## convert width to width of each cell
width <- width * (df$x %>% range %>% diff) / diff(window)
df=df[df$isTip,]
start <- max(df$x) * 1.02 + offset
seqs <- seqs[df$label[order(df$y)]]
## seqs.df <- do.call("rbind", seqs)
......@@ -101,3 +102,96 @@ dginn_msaplot <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL,
return(p)
}
dginn_msaplot_summary <- function(p, fasta, offset=0, width=1, color=NULL, window=NULL, dginn_summary=NULL, bg_line = TRUE, height = 0.8){
if (missingArg(fasta)) {
x <- NULL
} else if (is(fasta, "DNAbin") || is(fasta, "AAbin") ) {
x <- fasta
} else if (is(fasta, "character")) {
x <- treeio::read.fasta(fasta)
} else {
x <- NULL
}
if (is.null(x) && is(p, "treedata") && length(p@tip_seq)) {
x <- p@tip_seq
}
if (is.null(x)) {
stop("multiple sequence alignment is not available...\n-> check the parameter 'fasta'...")
}
x <- as.matrix(x)
if (!all(labels(x) %in% p$data$label)) {
stop("taxa name in input sequences are not match with the ones on the tree, please check your input files...")
}
if (is.null(window)) {
window <- c(1, ncol(x))
}
slice <- seq(window[1], window[2], by=1)
x <- x[, slice]
seqs <- lapply(1:nrow(x), function(i) {
seq <- as.vector(as.character(x[i,]))
seq[seq %in% c('a','t','g','c','*')] <- 'MSA'
seq[! seq %in% c('PSS','MSA')] <- '-'
return(seq)
})
names(seqs) <- labels(x)
df <- p$data
## if (is.null(width)) {
## width <- (df$x %>% range %>% diff)/500
## }
## convert width to width of each cell
width <- width * (df$x %>% range %>% diff) / diff(window)
df=df[df$isTip,]
start <- max(df$x) * 1.02 + offset
h <- ceiling(diff(range(df$y))/length(df$y))
xmax <- start + seq_along(slice) * width
xmin <- xmax - width
y <- sort(df$y)
ymin <- y - height/2 *h
ymax <- y + height/2 *h
from <- to <- NULL
ps <- ggplot() + xlim(0,max(xmax))
lines.df <- data.frame(from=min(xmin), to=max(xmax), y = y)
if (bg_line) {
p <- p + geom_segment(data=lines.df, aes(x=from, xend=to, y=y, yend=y),
size=h*.2, inherit.aes = FALSE)
}
color=c("yellow","red","blue","green","black")
summary_df=data.frame(xmin=numeric(),xmax=numeric(),ymin=numeric(),ymax==numeric(),color=character())
#add dginn summary info
for(i in 2:length(dginn_summary)){
if(! is.na(dginn_summary[[i]])){
for(j in 1:length(dginn_summary[[i]])){
xmin_s=min(xmin)+(dginn_summary[[i]][j]*3*width)
xmax_s=xmin_s-(3*width)
ymin_s=(i*0.1)-0.1
ymax_s=i*0.1
summary_df <- rbind(summary_df,data.frame(xmin=xmin_s,xmax=xmax_s,ymin=ymin_s,ymax=ymax_s,model=names(dginn_summary)[i]))
}
}
}
ps <- ps + geom_rect(data=summary_df,aes(xmin=xmin, xmax=xmax, ymin=ymin, ymax=ymax,color=model,fill=model)) + ylim(c(0,0.5))+theme_tree()
return(ps)
}
......@@ -22,8 +22,7 @@ shinyServer(
# renderDataTable -- DGINN data table
output$dginn_data <- DT::renderDataTable({
print("renderDataTable")
df <- dginn_df_reactive()
......@@ -43,12 +42,34 @@ shinyServer(
file_url=paste(path,gene,file,sep="/")
tree=read.tree(paste(file_url,".phylip_phyml_tree.txt",sep=""))
model=input$model_parameter_rb
dginn_position=as.character(dginn_df_reactive()[selected,paste(model,"PSS",sep="_")])
#
# get dginn_data_model_summary
#
models <- c("BppM1M2","BppM7M8","BppDFP07_0DFP07","codemlM1M2","codemlM7M8")
dginn_data_model_summary <- list()
dginn_data_model_summary[1] <- c()
for(i in 1:length(models)){
if(as.character(dginn_df_reactive()[selected,paste(models[i],"PSS",sep="_")]) !="na"){
dginn_position <- as.character(dginn_df_reactive()[selected,paste(models[i],"PSS",sep="_")])
dginn_data_model_summary[1] = c(dginn_data_model_summary[1],as.integer(strsplit(dginn_position,",")[[1]]))
dginn_data_model_summary[[i+1]]= as.integer(strsplit(dginn_position,",")[[1]])
}
else{
dginn_data_model_summary[[i+1]] <- NA
}
}
names(dginn_data_model_summary) <- c("summary",models)
dginn_data_model_summary$summary <- table(dginn_data_model_summary$summary)
print(dginn_data_model_summary)
p <- ggtree(tree) + geom_tiplab(size=3)
dginn_msaplot(p, paste(file_url,".fas",sep=""),dginn_position=as.integer(strsplit(dginn_position,",")[[1]]), offset=1, width=5)
#msaplot(p, paste(file_url,".fas",sep=""), offset=1, width=5)
p_msa <- dginn_msaplot(p, paste(file_url,".fas",sep=""),dginn_position=as.numeric(names(dginn_data_model_summary$summary)), offset=1, width=5)
p_msa_summary <- dginn_msaplot_summary(p, paste(file_url,".fas",sep=""),dginn_summary=dginn_data_model_summary, offset=1, width=5)
grid.arrange(p_msa+ theme(legend.position = "none"),p_msa_summary + theme(legend.position = "none"),nrow=2,ncol=1)
}
}
)
......
......@@ -23,8 +23,8 @@ shinyUI(fluidPage(
tabPanel("DGINN dataset",
DT::dataTableOutput("dginn_data"),
plotOutput("ggtree_plot"),
radioButtons("model_parameter_rb", label = "Select model:",choices = list("BppM1M2","BppM7M8","BppDFP07_0DFP07","codemlM1M2","codemlM7M8"), selected = "BppM1M2")
plotOutput("ggtree_plot")
#, radioButtons("model_parameter_rb", label = "Select model:",choices = list("BppM1M2","BppM7M8","BppDFP07_0DFP07","codemlM1M2","codemlM7M8"), selected = "BppM1M2")
)
)
)
......
Markdown is supported
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