tb-host-dashboard/tb_host/app.R
2022-12-11 19:47:38 +00:00

319 lines
13 KiB
R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
library(shinyjs)
library(shinydashboard)
#library("wesanderson") # ayyyy lmao hipster af
library(dplyr)
library(DT)
library(ggplot2)
library(grid) # for the info box
library(plotly)
library(shinycssloaders)
library(NGLVieweR)
library(httr)
library(readr)
library(RCurl)
# make shiny non-stupid
options(shiny.launch.browser = FALSE) # i am a big girl and can tie my own laces
options(shiny.port = 8000) # don't change the port every time
options(shiny.host = '0.0.0.0') # This means "listen to all addresses on all interfaces"
options(DT.options = list(scrollX = TRUE))
# An "application token" is required here. I generated this one like this:
# curl -H "Content-Type: application/json" -d '{"name":"r-data"}' -u <username>:<password> https://git.tunstall.in/api/v1/users/sethp/tokens
# Gitea access token
access_token = read_lines("~/secret-token")
gene_url = "https://git.tunstall.in/api/v1/repos/tanu/fellowship_dcdf/raw/tb_data_fc/dashboard/list_unique_missense_genes.csv"
missense_gene_url = "https://git.tunstall.in/api/v1/repos/tanu/fellowship_dcdf/raw/tb_data_fc/dashboard/missense_genes_params.csv"
alphafold_url = "https://alphafold.ebi.ac.uk/files/"
genes=read_csv(paste0(gene_url,"?token=",access_token))
unique_missense_genes = read_delim(paste0(missense_gene_url,"?token=",access_token))
#genes = c("Gene 1", "Gene 2", "Gene 3", "Gene 4", "Gene 5")
# Define UI for application that draws a histogram
ui=dashboardPage(skin="purple",
dashboardHeader(title="Tuberculosis Host"),
dashboardSidebar(
radioButtons("gene",
label="Gene",
choices = genes$Gene,
selected="alr" # "alr" is a value
),
actionButton("clear_ngl",
"Reset Structures"),
actionButton("all_mutations",
"All Mutations")
),
dashboardBody(
useShinyjs(),
fluidRow(
box(
title="Crystallised Structure",
width=5,
column(
NGLVieweROutput("structure"),
width=12
)
),
box(
title="AlphaFold Structure",
width=5,
column(
NGLVieweROutput("af_structure"),
width=12
)
),
box(
title="Mutation Information",
width=2,
column(
htmlOutput("information"),
width=12
)
)
),
fluidRow(
column(
DT::dataTableOutput('table'),
width=12
)
),
verbatimTextOutput("debug")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white',
xlab = 'Waiting time to next eruption (in mins)',
main = 'Histogram of waiting times')
})
### NGLViewer ####
# Structure Viewer WebGL/NGLViewR window
output$structure <- renderNGLVieweR({
selected_gene=input$gene
ngl_gene=as.character(genes[genes$Gene==selected_gene,"PDB"])
NGLVieweR(ngl_gene) %>%
addRepresentation("cartoon",
param = list(name = "cartoon",
color="tan",
#colorScheme = "bfactor",
opacity = 1
)
) %>%
stageParameters(backgroundColor = "white") %>%
setQuality("high") %>%
setFocus(0) %>%
setSpin(FALSE)
})
output$af_structure <- renderNGLVieweR({
selected_af_gene=input$gene
ngl_af_gene=as.character(genes[genes$Gene==selected_af_gene,"AF_PDB"])
#af_pdb=cat(content(GET(paste0(alphafold_url,"AF-",ngl_af_gene,"-F1-model_v4.pdb")), as="text"), "\n")
af_pdb=content(GET(paste0(alphafold_url,"AF-",ngl_af_gene,"-F1-model_v4.pdb")), as="text")
#print(af_pdb)
#ngl_pdb_file=paste0(load_dir, "Data/", ngl_drug, '/output/depth/', ngl_gene, '_complex.pdb')
NGLVieweR(af_pdb, format="pdb") %>%
addRepresentation("cartoon",
param = list(name = "cartoon",
#color="tan"
colorScheme = "bfactor",
opacity = 1
)
) %>%
stageParameters(backgroundColor = "white") %>%
setQuality("high") %>%
setFocus(0) %>%
setSpin(FALSE)
})
# output$table <- DT::renderDataTable({
# selected_gene=input$gene
# gene=as.character(genes[genes$Gene==selected_gene,"Gene"])
# #unique_missense_genes[unique_missense_genes$gene_name==gene,]
# unique_missense_genes
# },
# selection = "single",
# search = list(search="alr"))
output$table <- DT::renderDataTable(
unique_missense_genes,
selection = "single",
options=list(
search = list(search=as.character(genes[genes$Gene==input$gene,"Gene"]))
)
)
observeEvent(input$table_rows_selected,{
#req(length(input$table_row_selected) > 0)
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
# coming down from the trees was a mistake, and abandoning Perl doubly so.
clicked_position = regmatches(mutation, regexpr("[0-9]+", mutation, perl=TRUE))
# Now update the 3D structure to highlight the clicked thing and then zoom in.
NGLVieweR_proxy("structure") %>%
#addSelection('ball+stick'
addSelection('spacefill'
, param = list(
name = "Pos"
, sele = trimws(paste0(clicked_position,':', chain))
, color = "red"
#, colorValue="00ff00"
#, colorScheme="element"
)
)
NGLVieweR_proxy("af_structure") %>%
#addSelection('ball+stick'
addSelection('spacefill'
, param = list(
name = "Pos"
, sele = clicked_position
, color = "red"
#, colorValue="00ff00"
#, colorScheme="element"
)
)
NGLVieweR_proxy("af_structure") %>% updateZoomMove(
center = clicked_position,
zoom = clicked_position,
duration = 1000, # animation time in ms
z_offSet = -1
)
NGLVieweR_proxy("structure") %>% updateZoomMove(
center = trimws(paste0(clicked_position,':', chain)),
zoom = trimws(paste0(clicked_position,':', chain)),
duration = 1000, # animation time in ms
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({
# print(c(mutation, clicked_position))
# })
})
observeEvent(
{
input$clear_ngl
}, {
NGLVieweR_proxy("structure") %>%
removeSelection("Pos") %>%
removeSelection("all_mutations_surface") %>%
updateVisibility("cartoon", TRUE) %>%
removeSelection("all_mutations")
NGLVieweR_proxy("af_structure") %>%
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(":",
as.matrix(unique_missense_genes[unique_missense_genes$gene_name == gene,c("chain")])[1],
" and (",
paste0(
apply(
unique_missense_genes[unique_missense_genes$gene_name == gene,c("position","chain")],
1,
function(x){
paste0(trimws(x[1])
)}
),
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="red",
sele = mutations
#colorScheme = "bfactor",
#opacity = 1
)
)
NGLVieweR_proxy("af_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="red",
sele = mutations
#colorScheme = "bfactor",
#opacity = 1
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)