tanu/tb-host-dashboard
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

aaaaaaa

Browse source
This commit is contained in:
Tanushree Tunstall 2022-12-11 19:26:29 +00:00
parent e7725235bb
commit 568fef38ae
1 changed files with 115 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

131
tb_host/app.R
View file

@ -52,23 +52,34 @@ ui=dashboardPage(skin="purple",
selected="alr" # "alr" is a value selected="alr" # "alr" is a value
), ),
actionButton("clear_ngl", actionButton("clear_ngl",
"Clear Structures") "Reset Structures"),
actionButton("all_mutations",
"All Mutations")
), ),
dashboardBody( dashboardBody(
useShinyjs(), useShinyjs(),
fluidRow( fluidRow(
box( box(
title="Crystallised Structure", title="Crystallised Structure",
width=5,
column( column(
NGLVieweROutput("structure"), NGLVieweROutput("structure"),
width=12 width=12
)
),
box(
title="AlphaFold Structure",
width=5,
column(
NGLVieweROutput("af_structure"),
width=12
) )
), ),
box( box(
title="AlphaFold Structure", title="Mutation Information",
width=2,
column( column(
NGLVieweROutput("af_structure"), htmlOutput("information"),
width=12 width=12
) )
) )
@ -104,8 +115,8 @@ server <- function(input, output) {
NGLVieweR(ngl_gene) %>% NGLVieweR(ngl_gene) %>%
addRepresentation("cartoon", addRepresentation("cartoon",
param = list(name = "cartoon", param = list(name = "cartoon",
#color="tan" color="tan",
colorScheme = "bfactor", #colorScheme = "bfactor",
opacity = 1 opacity = 1
) )
) %>% ) %>%
@ -155,6 +166,7 @@ server <- function(input, output) {
observeEvent(input$table_rows_selected,{ observeEvent(input$table_rows_selected,{
#req(length(input$table_row_selected) > 0) #req(length(input$table_row_selected) > 0)
mutation = as.character(unique_missense_genes[input$table_rows_selected,"hgvd_p"]) mutation = as.character(unique_missense_genes[input$table_rows_selected,"hgvd_p"])
chain = as.character(unique_missense_genes[input$table_rows_selected,"chain"])
# what the absolute FUCK is this mess? I JUST WANT THE MATCH ASDLASJASDASHFKLJASDFK # what the absolute FUCK is this mess? I JUST WANT THE MATCH ASDLASJASDASHFKLJASDFK
# coming down from the trees was a mistake, and abandoning Perl doubly so. # coming down from the trees was a mistake, and abandoning Perl doubly so.
clicked_position = regmatches(mutation, regexpr("[0-9]+", mutation, perl=TRUE)) clicked_position = regmatches(mutation, regexpr("[0-9]+", mutation, perl=TRUE))
@ -163,22 +175,22 @@ server <- function(input, output) {
NGLVieweR_proxy("structure") %>% NGLVieweR_proxy("structure") %>%
#addSelection('ball+stick' #addSelection('ball+stick'
addSelection('ball+stick' addSelection('spacefill'
, param = list( , param = list(
name = "Pos" name = "Pos"
, sele = clicked_position , sele = trimws(paste0(clicked_position,':', chain))
, color = "green" , color = "red"
#, colorValue="00ff00" #, colorValue="00ff00"
#, colorScheme="element" #, colorScheme="element"
) )
) )
NGLVieweR_proxy("af_structure") %>% NGLVieweR_proxy("af_structure") %>%
#addSelection('ball+stick' #addSelection('ball+stick'
addSelection('ball+stick' addSelection('spacefill'
, param = list( , param = list(
name = "Pos" name = "Pos"
, sele = clicked_position , sele = clicked_position
, color = "green" , color = "red"
#, colorValue="00ff00" #, colorValue="00ff00"
#, colorScheme="element" #, colorScheme="element"
) )
@ -191,12 +203,37 @@ server <- function(input, output) {
z_offSet = -1 z_offSet = -1
) )
NGLVieweR_proxy("structure") %>% updateZoomMove( NGLVieweR_proxy("structure") %>% updateZoomMove(
center = clicked_position, center = trimws(paste0(clicked_position,':', chain)),
zoom = clicked_position, zoom = trimws(paste0(clicked_position,':', chain)),
duration = 1000, # animation time in ms duration = 1000, # animation time in ms
z_offSet = -1 z_offSet = -1
) )
output$information <- renderUI({
selected_gene=input$gene
HTML(paste0("<strong>Mutation: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"mutationinformation"]),"<br/>",
"<strong>PDB ID: </strong>", as.character(genes[genes$Gene==selected_gene,"PDB"]),"<br/>",
"<strong>AlphaFold ID: </strong>", as.character(genes[genes$Gene==selected_gene,"AF_PDB"]), "<br/>",
"<strong>Ligand Distance: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"ligand_distance"]), "<br/>",
"<strong>mCSM Lig: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"mcsm_lig"]), "<br/>",
"<strong>mmCSM Lig: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"mmcsm_lig"]), "<br/>",
"<strong>mCSM DUET: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"ddg_duet"]), "<br/>",
"<strong>FoldX: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"ddg_foldx"]), "<br/>",
"<strong>DeepDDG: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"ddg_deepddg"]), "<br/>",
"<strong>Dynamut2: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"ddg_dynamut2"]), "<br/>",
"<strong>mCSM PPI2: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"mcsm_ppi2_affinity"]), "<br/>",
"<strong>Interface Distance: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"interface_dist"]), "<br/>",
"<strong>mCSM NA: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"mcsm_na_affinity"]), "<br/>",
"<strong>Consurf: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"consurf_score"]), "<br/>",
#"<strong>SNAP2: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"snap2_score"]), "<br/>",
"<strong>SNAP2 Outcome: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"snap2_outcome"]), "<br/>",
#"<strong>PROVEAN: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"provean_score"]), "<br/>",
"<strong>PROVEAN Outcome: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"provean_outcome"]), "<br/>",
"<strong>RSA: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"rsa"]), "<br/>",
"<strong>Residue Depth: </strong>", as.character(unique_missense_genes[input$table_rows_selected,"rd_values"]), "<br/>"
)
)
})
# output$debug <- renderPrint({ # output$debug <- renderPrint({
# print(c(mutation, clicked_position)) # print(c(mutation, clicked_position))
@ -207,9 +244,71 @@ server <- function(input, output) {
input$clear_ngl input$clear_ngl
}, { }, {
NGLVieweR_proxy("structure") %>% NGLVieweR_proxy("structure") %>%
removeSelection("Pos") removeSelection("Pos") %>%
removeSelection("all_mutations_surface") %>%
updateVisibility("cartoon", TRUE) %>%
removeSelection("all_mutations")
NGLVieweR_proxy("af_structure") %>% NGLVieweR_proxy("af_structure") %>%
removeSelection("Pos") removeSelection("Pos") %>%
removeSelection("all_mutations_surface") %>%
updateVisibility("cartoon", TRUE) %>%
removeSelection("all_mutations")
})
# add a surface representation and highlight all mutations on it
observeEvent(
{
input$all_mutations
}, {
gene = input$gene
mutations = paste0(
apply(
unique_missense_genes[unique_missense_genes$gene_name == gene,c("position","chain")],
1,
function(x){
paste0(trimws(x[1]),
":",
trimws(x[2])
)}
),
collapse=","
)
print(mutations)
NGLVieweR_proxy("structure") %>%
updateVisibility("cartoon", FALSE) %>%
addSelection(type="surface",
param = list(name = "all_mutations_surface",
sele = "all",
color="tan",
opacity = 0.2
)
) %>%
addSelection(type="surface",
param = list(name = "all_mutations",
color="green",
sele = "20:A, 22:A, 157:A"
#colorScheme = "bfactor",
#opacity = 1
)
)
# addSelection('spacefill',
# param = list(
# name = "Pos",
# sele = "4:A,20:A,22:A,157:A,344:A",
# color = "red",
# opacity=0.1
# )
# )
# NGLVieweR_proxy("af_structure") %>%
# addSelection('ball+stick',
# param = list(
# name = "Pos",
# sele = mutations,
# color = "red",
# opacity=0.1
# )
# )
}) })
} }