#' graph_pept_prot UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
mod_graph_pept_prot_ui <- function(id){
ns <- NS(id)
tagList(
tabPanel("Graph",
value = "graphTab",
tabsetPanel(
id = "graphsPanel",
tabPanel("Settings",
uiOutput(ns("pepInfoUI"))
),
tabPanel("CC one prot",
tagList(
shinyBS::bsCollapse(id = "collapseCCInfos",
open = "",
multiple = TRUE,
shinyBS::bsCollapsePanel("One - One CC",
fluidRow(
column(width=4, DT::dataTableOutput(ns("OneOneDT"))),
column(width=8, DT::dataTableOutput(ns("OneOneDTDetailed")))
),style = "info"),
shinyBS::bsCollapsePanel("One - Multi CC",
fluidRow(
column(width=4, DT::dataTableOutput(ns("OneMultiDT"))),
column(width=8, DT::dataTableOutput(ns("OneMultiDTDetailed")))
), style = "primary")
)
)
),
tabPanel("CC multi prot",
tagList(
#uiOutput(ns("CCTooltip_UI")),
# highchartOutput(ns("jiji")))
selectInput(ns("searchCC"), 'Search for CC',
choices = c('Tabular view' = 'tabular',
'Graphical view' = 'graphical'),
width='150px'),
fluidRow(
column(width=6,tagList(
highchartOutput(ns("jiji")),
shinyjs::hidden( dataTableOutput(ns('CCMultiMulti')))
)),
column(width=6, tagList(
visNetworkOutput(ns("visNet_CC"), height='600px')))
),
uiOutput(ns('CCDetailed'))
)
)
)
)
)
}
#' graph_pept_prot Server Function
#'
#' @noRd
mod_graph_pept_prot_server <- function(id, cc, matAdj, dataIn){
moduleServer(id, function(input, output, session){
ns <- session$ns
rv.cc <- reactiveValues(
## selected CC in global CC list (tab or plot)
selectedCC = NULL,
selectedNode = NULL,
selectedNeighbors = NULL,
selectedCCgraph = NULL,
# when the user selects a node in the graph
detailedselectedNode = list(
sharedPepLabels = NULL,
specPepLabels = NULL,
protLabels = NULL)
)
output$pepInfoUI <- renderUI({
dataIn()
selectInput(ns('pepInfo'), "PepInfo", choices=colnames(Biobase::fData(dataIn())),
multiple=TRUE)
})
observeEvent(req(input$searchCC), {
shinyjs::toggle('jiji', condition = input$searchCC=='graphical')
shinyjs::toggle('CCMultiMulti', condition = input$searchCC=='tabular')
})
# select a point in the grpah
observeEvent(input$click,{
rv.cc$selectedNode <- input$click
})
# Get the id of selected neighbors in the graph
observeEvent(input$visNet_CC_highlight_color_id,{
rv.cc$selectedNeighbors <- input$visNet_CC_highlight_color_id
})
# select a CC in the summary table
observeEvent(input$CCMultiMulti_rows_selected, {
rv.cc$selectedCC <- input$CCMultiMulti_rows_selected
})
# select a CC in the jitter plot
observeEvent(req(input$eventPointClicked), {
this.index <- as.integer(strsplit(input$eventPointClicked, "_")[[1]][1])
this.index+1
rv.cc$selectedCC <- this.index+1
})
output$visNet_CC <- renderVisNetwork({
req(rv.cc$selectedCC)
local <- cc()[Get_CC_Multi2Any()]
print(local[[rv.cc$selectedCC]])
rv.cc$selectedCCgraph <- buildGraph(local[[rv.cc$selectedCC]], matAdj())
display.CC.visNet(rv.cc$selectedCCgraph) %>%
visEvents(click = paste0("function(nodes){
Shiny.onInputChange('",ns("click"),"', nodes.nodes[0]);
Shiny.onInputChange('",ns("node_selected"), "', nodes.nodes.length);
;}")
) %>%
visOptions(highlightNearest = TRUE )
})
output$jiji <- renderHighchart({
tooltip <- NULL
isolate({
local <- cc()[Get_CC_Multi2Any()]
n.prot <- unlist(lapply(local, function(x){length(x$proteins)}))
n.pept <- unlist(lapply(local, function(x){length(x$peptides)}))
df <- tibble(x=jitter(n.pept),
y = jitter(n.prot),
index = 1:length(local))
if (!is.null( tooltip)){
df <- cbind(df,Biobase::fData(dataIn())[ tooltip])
}
colnames(df) <- gsub(".", "_", colnames(df), fixed=TRUE)
if (ncol(df) > 3){
colnames(df)[4:ncol(df)] <-
paste("tooltip_", colnames(df)[4:ncol(df)], sep="")
}
clickFun <-
JS(paste0("function(event) {Shiny.onInputChange('",ns("eventPointClicked"),"', [this.index]+'_'+ [this.series.name]);}"))
rv.core$tempplot$plotCC <- DAPAR2::plotJitter_rCharts(df, clickFunction=clickFun)
})
rv.core$tempplot$plotCC
})
output$CCMultiMulti <- renderDataTable({
Get_CC_Multi2Any()
df <- do.call(rbind,lapply(cc()[Get_CC_Multi2Any()],
function(x){
data.frame(rbind(x),
nPep = length(x$peptides),
nProt = length(x$proteins))}))
df <- cbind(df,id = 1:nrow(df))
df <- df[c('id', 'nProt', 'nPep', 'proteins', 'peptides')]
dat <- DT::datatable(df,
selection = 'single',
rownames=FALSE,
extensions = c('Scroller', 'Buttons'),
options=list(initComplete = initComplete(),
dom='Bfrtip',
deferRender = TRUE,
bLengthChange = FALSE,
scrollX = 400,
scrollY = 400,
displayLength = 10,
scroller = TRUE,
orderClasses = TRUE,
autoWidth=TRUE,
columns.searchable=F,
columnDefs = list(list(columns.width=c("60px"),
columnDefs.targets=c(list(0),list(1),list(2))))))
return(dat)
})
observeEvent(c(rv.cc$selectedNeighbors,input$node_selected,rv.cc$selectedCCgraph), {
local <- cc()[Get_CC_Multi2Any()]
rv.cc$selectedNeighbors
nodes <- rv.cc$selectedCCgraph$nodes
if(!is.null(input$node_selected) && input$node_selected == 1){
sharedPepIndices <- intersect(rv.cc$selectedNeighbors, which(nodes[,'group'] == "shared.peptide"))
specPepIndices <- intersect(rv.cc$selectedNeighbors, which(nodes[,'group'] == "spec.peptide"))
protIndices <- intersect(rv.cc$selectedNeighbors,which(nodes[,'group'] == "protein"))
} else {
sharedPepIndices <- which(nodes[,'group'] == "shared.peptide")
specPepIndices <- which(nodes[,'group'] == "spec.peptide")
protIndices <- which(nodes[,'group'] == "protein")
}
rv.cc$detailedselectedNode$sharedPepLabels <- as.numeric(nodes[sharedPepIndices, 'label'])
rv.cc$detailedselectedNode$specPepLabels <- as.numeric(nodes[specPepIndices, 'label'])
rv.cc$detailedselectedNode$protLabels <- as.numeric(nodes[protIndices, 'label'])
})
output$CCDetailed <- renderUI({
req(rv.cc$detailedselectedNode)
req(rv.cc$selectedCC)
tagList(
h4("Proteins"),
dataTableOutput(ns('CCDetailedProt')),
h4("Specific peptides"),
dataTableOutput(ns('CCDetailedSpecPep')),
h4("Shared peptides"),
dataTableOutput(ns('CCDetailedSharedPep'))
)
})
output$CCDetailedProt<- renderDataTable({
req(rv.cc$selectedCC)
rv.cc$detailedselectedNode
if(is.null(rv.cc$detailedselectedNode$protLabels)){return(NULL)}
df <- data.frame(proteinId = unlist(rv.cc$detailedselectedNode$protLabels)
#other = rep(NA,length(rv.cc$detailedselectedNode$protLabels))
)
dt <- datatable( df,
extensions = c('Scroller'),
options = list(initComplete = initComplete(),
dom='rt',
blengthChange = FALSE,
ordering=FALSE,
scrollX = 400,
scrollY = 100,
displayLength = 10,
scroller = TRUE,
header=FALSE,
server = FALSE))
dt
})
#######
output$CCDetailedSharedPep <- renderDataTable({
rv.cc$detailedselectedNode
input$pepInfo
if(is.null((rv.cc$detailedselectedNode$sharedPepLabels))){return(NULL)}
ind <- 1:ncol(dataIn())
data <- getDataForExprs(dataIn())
pepLine <- rv.cc$detailedselectedNode$sharedPepLabels
indices <- unlist(lapply(pepLine, function(x){which(rownames(data)==x)}))
data <- data[indices,c(ind, (ind + ncol(data)/2))]
if(!is.null(input$pepInfo))
{
data <- cbind(data, Biobase::fData(dataIn())[pepLine,input$pepInfo])
colnames(data)[(1+ncol(data)-length(input$pepInfo)):ncol(data)] <- input$pepInfo
}
offset <- length(input$pepInfo)
dt <- datatable( data,
extensions = c('Scroller'),
options = list(initComplete = initComplete(),
dom='rt',
blengthChange = FALSE,
ordering=FALSE,
scrollX = 400,
scrollY = 150,
displayLength = 10,
scroller = TRUE,
header=FALSE,
server = FALSE,
columnDefs = list(list(targets = c((((ncol(data)-offset)/2)+1):(ncol(data)-offset)), visible = FALSE))
)) %>%
DT::formatStyle(
colnames(data)[1:((ncol(data)-offset)/2)],
colnames(data)[(((ncol(data)-offset)/2)+1):(ncol(data)-offset)],
backgroundColor = DT::styleEqual(c("POV", "MEC"), c(rv.prostar$settings()$colorsTypeMV$POV, rv.prostar$settings()$colorsTypeMV$MEC)))
dt
})
#####-----------
output$CCDetailedSpecPep <- renderDataTable({
rv.cc$detailedselectedNode
input$pepInfo
if(is.null((rv.cc$detailedselectedNode$specPepLabels))){return(NULL)}
ind <- 1:ncol(dataIn())
data <- getDataForExprs(dataIn())
pepLine <- rv.cc$detailedselectedNode$specPepLabels
indices <- unlist(lapply(pepLine, function(x){which(rownames(data)==x)}))
data <- data[indices,c(ind, (ind + ncol(data)/2))]
if(!is.null(input$pepInfo))
{
data <- cbind(data, Biobase::fData(dataIn())[pepLine,input$pepInfo])
colnames(data)[(1+ncol(data)-length(input$pepInfo)):ncol(data)] <- input$pepInfo
}
offset <- length(input$pepInfo)
dt <- datatable( data,
extensions = c('Scroller'),
options = list(initComplete = initComplete(),
dom='rt',
blengthChange = FALSE,
ordering=FALSE,
scrollX = 400,
scrollY = 100,
displayLength = 10,
scroller = TRUE,
header=FALSE,
server = FALSE,
columnDefs = list(list(targets = c((((ncol(data)-offset)/2)+1):(ncol(data)-offset)), visible = FALSE))
)) %>%
DT::formatStyle(
colnames(data)[1:((ncol(data)-offset)/2)],
colnames(data)[(((ncol(data)-offset)/2)+1):(ncol(data)-offset)],
backgroundColor = DT::styleEqual(c("POV", "MEC"), c(rv.prostar$settings()$colorsTypeMV$POV, rv.prostar$settings()$colorsTypeMV$MEC)))
dt
})
Get_CC_One2One <- reactive({
cc()
ll.prot <- lapply(cc(), function(x){length(x$proteins)})
ll.pept <- lapply(cc(), function(x){length(x$peptides)})
ll.prot.one2one <- intersect(which(ll.prot == 1),which(ll.pept == 1))
ll.prot.one2one
})
Get_CC_One2multi <- reactive({
cc()
ll.prot <- lapply(cc(), function(x){length(x$proteins)})
ll.pept <- lapply(cc(), function(x){length(x$peptides)})
ll.prot.one2multi <- intersect(which(ll.prot == 1),which(ll.pept > 1))
ll.prot.one2multi
})
Get_CC_Multi2Any <- reactive({
cc()
ll.prot <- lapply(cc(), function(x){length(x$proteins)})
ll.pept <- lapply(cc(), function(x){length(x$peptides)})
ll.prot.multi2any <- which(ll.prot > 1)
ll.prot.multi2any
})
BuildOne2OneTab <- reactive({
cc()
table <- do.call(rbind,lapply(cc()[Get_CC_One2One()],function(x){data.frame(rbind(x))}))
table
})
BuildOne2MultiTab <- reactive({
cc()
table <- do.call(rbind,lapply(cc()[Get_CC_One2multi()],function(x){data.frame(rbind(x), nPep = length(x$peptides))}))
table <- table[c('proteins', 'nPep', 'peptides')]
table
})
BuildMulti2AnyTab <- reactive({
cc()
table <- do.call(rbind,lapply(cc()[Get_CC_Multi2Any()],function(x){data.frame(rbind(x), nPep = length(x$peptides))}))
table <- table[c('proteins', 'nPep', 'peptides')]
table
})
output$OneMultiDT <- renderDataTable({
req(cc())
dat <- DT::datatable(BuildOne2MultiTab(),
selection = 'single',
rownames=FALSE,
extensions = c('Scroller', 'Buttons'),
options=list(initComplete = initComplete(),
dom='Bfrtip',
deferRender = TRUE,
bLengthChange = TRUE,
displayLength = 10,
scrollX = 400,
scrollY = 400,
scroller = TRUE,
orderClasses = TRUE,
autoWidth=FALSE,
columns.searchable=F,
columnDefs = list(list(columns.width=c("60px"),
columnDefs.targets=c(list(0),list(1),list(2))))))
return(dat)
})
output$OneMultiDTDetailed <- renderDataTable({
input$pepInfo
req(input$OneMultiDT_rows_selected)
line <- input$OneMultiDT_rows_selected
ind <- 1:ncol(dataIn())
data <- getDataForExprs(dataIn())
pepLine <- as.numeric(unlist(BuildOne2MultiTab()[line,"peptides"]))
indices <- unlist(lapply(pepLine, function(x){which(rownames(data)==x)}))
data <- data[indices,c(ind, (ind + ncol(data)/2))]
if(!is.null(input$pepInfo))
{
data <- cbind(data, Biobase::fData(dataIn())[pepLine,input$pepInfo])
colnames(data)[(1+ncol(data)-length(input$pepInfo)):ncol(data)] <- input$pepInfo
}
offset <- length(input$pepInfo)
dt <- datatable( data,
extensions = c('Scroller', 'Buttons'),
options = list(initComplete = initComplete(),
dom='Bfrtip',
pageLength = 10,
blengthChange = FALSE,
displayLength = 10,
ordering=FALSE,
header=FALSE,
server = FALSE,
columnDefs = list(list(targets = c((((ncol(data)-offset)/2)+1):(ncol(data)-offset)), visible = FALSE))
)) %>%
DT::formatStyle(
colnames(data)[1:((ncol(data)-offset)/2)],
colnames(data)[(((ncol(data)-offset)/2)+1):(ncol(data)-offset)],
backgroundColor = DT::styleEqual(c("POV", "MEC"), c(rv.prostar$settings()$colorsTypeMV$POV, rv.prostar$settings()$colorsTypeMV$MEC)))
dt
})
output$OneOneDT <- renderDataTable({
req(cc())
dat <- DT::datatable(BuildOne2OneTab(),
selection = 'single',
rownames=FALSE,
extensions = c('Scroller', 'Buttons'),
options=list(initComplete = initComplete(),
dom='Bfrtip',
deferRender = TRUE,
bLengthChange = FALSE,
scrollX = 400,
scrollY = 200,
scroller = TRUE,
orderClasses = TRUE,
autoWidth=FALSE,
columns.searchable=F,
columnDefs = list(list(columns.width=c("60px"),
columnDefs.targets=c(list(0),list(1),list(2))))))
return(dat)
})
output$OneOneDTDetailed <- renderDataTable({
req(cc())
req(input$OneOneDT_rows_selected)
input$pepInfo
line <- input$OneOneDT_rows_selected
ind <- 1:ncol(dataIn())
data <- getDataForExprs(dataIn())
pepLine <- as.numeric(BuildOne2OneTab()[line,2])
indices <- unlist(lapply(pepLine, function(x){which(rownames(data)==x)}))
data <- data[indices,c(ind, (ind + ncol(data)/2))]
if(!is.null(input$pepInfo))
{
data <- cbind(data, Biobase::fData(dataIn())[pepLine,input$pepInfo])
colnames(data)[(1+ncol(data)-length(input$pepInfo)):ncol(data)] <- input$pepInfo
}
offset <- length(input$pepInfo)
dt <- datatable( data,
extensions = c('Scroller', 'Buttons'),
options = list(initComplete = initComplete(),
dom='Bfrtip',
blengthChange = FALSE,
pageLength = 10,
displayLength = 10,
ordering=FALSE,
header=FALSE,
server = FALSE,
columnDefs = list(list(targets = c((((ncol(data)-offset)/2)+1):(ncol(data)-offset)), visible = FALSE))
)) %>%
DT::formatStyle(
colnames(data)[1:((ncol(data)-offset)/2)],
colnames(data)[(((ncol(data)-offset)/2)+1):(ncol(data)-offset)],
backgroundColor = DT::styleEqual(c("POV", "MEC"), c(rv.prostar$settings()$colorsTypeMV$POV, rv.prostar$settings()$colorsTypeMV$MEC)))
dt
})
})
}
## To be copied in the UI
# mod_graph_pept_prot_ui("graph_pept_prot_ui_1")
## To be copied in the server
# callModule(mod_graph_pept_prot_server, "graph_pept_prot_ui_1")
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.