#' Protein domain architecture plot
#' @param pointInfo() info of clicked point
#' (from reactive fn "pointInfoDetail")
#' @param domainInfo() domain information
#' (from reactive fn "getDomainInformation")
#' @param labelArchiSize lable size (from input$labelArchiSize)
#' @param titleArchiSize title size (from input$titleArchiSize)
#' @param archiHeight plot height (from input$archiHeight)
#' @param archiWidth plot width (from input$archiWidth)
#' @author Vinh Tran {tran@bio.uni-frankfurt.de}
source("R/functions.R")
createArchitecturePlotUI <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("archiPlot.ui")),
downloadButton(ns("archiDownload"), "Download plot", class = "butDL"),
tags$head(
tags$style(HTML(
".butDL{background-color:#476ba3;} .butDL{color: white;}"))
),
textOutput(ns("selectedDomain")),
tableOutput(ns("domainTable")),
HTML(
paste0(
"<p><em><strong>Disclaimer:</strong> ",
"External links are automatically generated and may point to ",
"a wrong target (see <a ",
"href=\"https://github.com/BIONF/PhyloProfile/wiki/FAQ",
"#wrong-info-from-public-databases\" ",
"target=\"_blank\">FAQ</a>)</em></p>"
)
)
)
}
createArchitecturePlot <- function(
input, output, session,
pointInfo, domainInfo,
labelArchiSize, titleArchiSize, archiHeight, archiWidth
){
output$archiPlot <- renderPlot({
if (is.null(nrow(domainInfo()))) stop("Domain info is NULL!")
g <- createArchiPlot(
pointInfo(), domainInfo(), labelArchiSize(), titleArchiSize()
)
if (any(g == "No domain info available!")) {
msgPlot()
} else {
grid.draw(g)
}
})
output$archiPlot.ui <- renderUI({
ns <- session$ns
if (is.null(nrow(domainInfo()))) {
msg <- paste0(
"<p><em>Wrong domain file has been uploaded!
Please check the correct format in
<a href=\"https://github.com/BIONF/PhyloProfile/wiki/",
"Input-Data#ortholog-annotations-eg-domains\"
target=\"_blank\" rel=\"noopener\">our PhyloProfile wiki</a>.</em></p>"
)
HTML(msg)
} else {
# shinycssloaders::withSpinner(
plotOutput(
ns("archiPlot"),
height = archiHeight(),
width = archiWidth(),
click = ns("archiClick")
)
# )
}
})
output$archiDownload <- downloadHandler(
filename = function() {
c("domains.pdf")
},
content = function(file) {
g <- createArchiPlot(
pointInfo(), domainInfo(), labelArchiSize(), titleArchiSize()
)
grid.draw(g)
ggsave(
file, plot = g,
width = archiWidth() * 0.056458333,
height = archiHeight() * 0.056458333,
units = "cm", dpi = 300, device = "pdf", limitsize = FALSE
)
}
)
# output$selectedDomain <- renderText({
# if (is.null(input$archiClick$y)) return("No domain selected!")
# convertY(unit(input$archiClick$y, "npc"), "native")
# })
output$domainTable <- renderTable({
features <- getDomainLink(pointInfo(), domainInfo())
features
}, sanitize.text.function = function(x) x)
}
#' plot error message
#' @return error message in a ggplot object
#' @author Vinh Tran {tran@bio.uni-frankfurt.de}
msgPlot <- function() {
msg <- paste(
"No information about domain architecture!",
"Please check:","if you uploaded the correct domain file/folder; or ",
"if the selected genes (seed & ortholog) do exist in the uploaded file",
"(please search for the corresponding seedID and hitID)",
sep = "\n"
)
x <- c(1,2,3,4,5)
y <- c(1,2,3,4,5)
g <- ggplot(data.frame(x, y), aes(x,y)) +
geom_point(color = "white") +
annotate(
"text", label = msg, x = 3.5, y = 0.5, size = 5, colour = "red"
) +
theme(axis.line = element_blank(), axis.text = element_blank(),
axis.ticks = element_blank(), axis.title = element_blank(),
panel.background = element_blank(),
panel.border = element_blank(),
panel.grid = element_blank(),
plot.background = element_blank()) +
ylim(0,1)
return(g)
}
getDomainLink <- function(info, domainDf){
group <- as.character(info[1])
ortho <- as.character(info[2])
# get sub dataframe based on selected groupID and orthoID
group <- gsub("\\|", ":", group)
ortho <- gsub("\\|", ":", ortho)
grepID <- paste(group, "#", ortho, sep = "")
subdomainDf <- domainDf[grep(grepID, domainDf$seedID), ]
subdomainDf$feature <- as.character(subdomainDf$feature)
orthoID <- NULL
feature <- NULL
if (nrow(subdomainDf) < 1) return(paste0("No domain info available!"))
else {
# ortho & seed domains df
orthoDf <- subdomainDf[subdomainDf$orthoID == ortho,]
seedDf <- subdomainDf[subdomainDf$orthoID != ortho,]
feature <- c(
levels(as.factor(orthoDf$feature)),
levels(as.factor(seedDf$feature))
)
}
# get URL
feature <- unique(feature[grep("pfam|smart", feature)])
feature <- sub("_","@", feature)
tmpDf <- data.frame(
do.call('cbind', data.table::tstrsplit(as.character(feature), '@', fixed = TRUE))
)
featDf <- data.frame("ID" = levels(as.factor(tmpDf$X2)))
featDf$PFAM <- paste0(
"<a href='https://pfam.xfam.org/family/", featDf$ID,
"' target='_blank'>", featDf$ID, "</a>"
)
featDf$SMART <- paste0(
"<a href='http://smart.embl-heidelberg.de/smart/",
"do_annotation.pl?BLAST=DUMMY&DOMAIN=",
featDf$ID, "' target='_blank'>",
featDf$ID, "</a>"
)
return(featDf)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.