library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(chemdoodle)
library(miniUI)
library(shinyBS)
library(shinyjs)
library(ClearanceTool)
library(readr)
library(dplyr)
library(DT)
library(rJava)
library(sqldf)
library(RSQLite)
library(usethis)
library(BiocManager)
library(ChemmineR)#, lib.loc = "C:/Users/kbronson/Documents/R/win-library/3.6")
library(ChemmineOB)
library(neuralnet)
library(FNN)
# data("Endpoint", package = "ClearanceTool")
# data("Structures", package = "ClearanceTool")
# data("SubstanceIdentifiers", package = "ClearanceTool")
shinyApp(
ui = tagList(
useShinyjs(),
includeCSS('www/styles.css'),
tags$head(
tags$link(
rel='icon',
href='cropped-ScitoVation_icon-32x32.png',
sizes="32x32"
)
),
tags$style(
type='text/css',
'body {padding-top: 50px;}'
),
dashboardPagePlus(
title = "Clearance Tool",
header = dashboardHeaderPlus(
title = tagList(
div(
style = 'background-color: #fff; margin-left: -15px; margin-right: -15px;',
class = 'logo-lg',
tags$img(
height = 45,
src = 'sciv_logo_transparent.png'
)
),
div(
style = 'background-color: #fff; margin-left: -15px; margin-right: -15px;',
img(
src = 'cropped-ScitoVation_icon-32x32.png'
)
)
),
enable_rightsidebar = TRUE,
rightSidebarIcon = "bars"
,fixed = T # Note this will hide the body's content without adding padding-top.,
),
sidebar = dashboardSidebar(
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem(
"Draw/Add Chemicals",
tabName = "drawAdd"
,icon = icon("pen")
),
menuItem(
"Single Chemical",
icon = icon("flask"),#icon(tags$img(src = 'Chemical Icon.png')),#icon("th"),
tabName = "singChem"
# ,badgeLabel = "new",
# badgeColor = "green"
),
menuItem(
"Batchmode",
icon = icon("table"),
tabName = "batchmode"
)
)
),
body = dashboardBody(
# style = 'padding-top: 65px;',
tabItems(
tabItem(
'drawAdd',
align = 'center',
# tags$style('#sketcher_button_open {display:none;} #sketcher_button_save {display:none;}'),
chemdoodle_sketcher(mol=NULL),
# chemdoodle_sketcher(mol = molData),
gadgetTitleBar("Draw A Molecule", right = miniTitleBarButton("done", "Done", primary = TRUE)),
h1(textOutput("smiles")),
tags$script(
'document.getElementById("done").onclick = function() {
var mol = sketcher.getMolecule();
var jsonmol = new ChemDoodle.io.JSONInterpreter().molTo(mol);
Shiny.onInputChange("moleculedata", jsonmol);
/*console.log(sketcher.specs);
sketcher.specs.scale *= 1.5; sketcher.checkScale(); sketcher.repaint();
console.log(sketcher.specs.scale); console.log(sketcher);*/};'
)
# ,tags$script(
# 'var sChem = document.getElementsByClassName("shiny-html-output shiny-bound-output")[0]["children"][0]["id"]
# document.getElementById("sChem").onscroll = function(){};
# '
# )
# ,tags$script(
# 'var myViewer = new ChemDoodle.ViewerCanvas(
# "myViewer",
# 300, 300);
# '
# )
# ,tags$script(
# "var sketcher = new ChemDoodle.SketcherCanvas(
# 'sketcher',
# 570, 440,
# {useServices:false, oneMolecule:true}
# );")
,fluidRow(
column(
12#,
# ,h1('Hello'),
# textOutput('errorChecking')
# bsButton(
# 'saveMol',
# 'Save Molecule',
# block = TRUE,
# style = 'primary',
# width = '80%'
# )
)
)
),
tabItem(
"singChem",
fluidRow(
style = 'height: 380px; margin-bottom: 15px;',
column(
5,
# style = 'min-width: 560px',
uiOutput('singleChem')
),
column(
7,
h4(
p(textOutput("myChem_1")),
p(textOutput("myChem_2")),
p(textOutput("myChem_3")),
p(textOutput("myChem_4")),
p(textOutput("myChem_5")),
p(textOutput("myChem_6")),
p(textOutput("myChem_7")),
p(textOutput("myChem_8")),
p(textOutput("myChem_9")),
p(textOutput("myChem_10")),
p(textOutput("myChem_11")),
p(textOutput("myChem_12")),
p(textOutput("myChem_13"))
)
)
),
fluidRow(
style = '
#height: 1500px;
#padding-top: 15px;
border-top: 1px solid;
#margin-top: 15px;
',
column(
3,
style = '
#border-top: 1px solid;
border-right: 1px solid;
padding-top: 15px;
',
uiOutput('neighbor1')
),
column(
3,
style = '
#border-top: 1px solid;
#border-left: 1px solid;
border-right: 1px solid;
padding-top: 15px;
',
uiOutput('neighbor2')
),
column(
3,
style = '
#border-top: 1px solid;
#border-left: 1px solid;
border-right: 1px solid;
padding-top: 15px;
',
uiOutput('neighbor3')
),
column(
3,
style = '
#border-top: 1px solid;
#border-left: 1px solid;
#border-right: 1px solid;
padding-top: 15px;
',
uiOutput('neighbor4')
)
),
fluidRow(
column(
3,
style = 'border-right: 1px solid; padding-top: 15px;',
tags$ul(
style = 'padding-left: 0px; list-style-type: none;',
tags$li(textOutput("nbt1_2")),
tags$li(textOutput("nbt1_3")),
tags$li(textOutput("nbt1_4")),
tags$li(textOutput("nbt1_5")),
tags$li(textOutput("nbt1_6")),
tags$li(textOutput("nbt1_7")),
tags$li(textOutput("nbt1_8")),
tags$li(textOutput("nbt1_9")),
tags$li(textOutput("nbt1_10")),
tags$li(textOutput("nbt1_11")),
tags$li(textOutput("nbt1_12")),
tags$li(textOutput("nbt1_13")),
tags$li(textOutput("nbt1_14"))
)
),
column(
3,
style = 'border-right: 1px solid; padding-top: 15px;',
tags$ul(
style = 'padding-left: 0px; list-style-type: none;',
tags$li(textOutput("nbt2_2")),
tags$li(textOutput("nbt2_3")),
tags$li(textOutput("nbt2_4")),
tags$li(textOutput("nbt2_5")),
tags$li(textOutput("nbt2_6")),
tags$li(textOutput("nbt2_7")),
tags$li(textOutput("nbt2_8")),
tags$li(textOutput("nbt2_9")),
tags$li(textOutput("nbt2_10")),
tags$li(textOutput("nbt2_11")),
tags$li(textOutput("nbt2_12")),
tags$li(textOutput("nbt2_13")),
tags$li(textOutput("nbt2_14"))
)
),
column(
3,
style = 'border-right: 1px solid; padding-top: 15px;',
tags$ul(
style = 'padding-left: 0px; list-style-type: none;',
tags$li(textOutput("nbt3_2")),
tags$li(textOutput("nbt3_3")),
tags$li(textOutput("nbt3_4")),
tags$li(textOutput("nbt3_5")),
tags$li(textOutput("nbt3_6")),
tags$li(textOutput("nbt3_7")),
tags$li(textOutput("nbt3_8")),
tags$li(textOutput("nbt3_9")),
tags$li(textOutput("nbt3_10")),
tags$li(textOutput("nbt3_11")),
tags$li(textOutput("nbt3_12")),
tags$li(textOutput("nbt3_13")),
tags$li(textOutput("nbt3_14"))
)
),
column(
3,
style = 'padding-top: 15px;',
tags$ul(
style = 'padding-left: 0px; list-style-type: none;',
tags$li(textOutput("nbt4_2")),
tags$li(textOutput("nbt4_3")),
tags$li(textOutput("nbt4_4")),
tags$li(textOutput("nbt4_5")),
tags$li(textOutput("nbt4_6")),
tags$li(textOutput("nbt4_7")),
tags$li(textOutput("nbt4_8")),
tags$li(textOutput("nbt4_9")),
tags$li(textOutput("nbt4_10")),
tags$li(textOutput("nbt4_11")),
tags$li(textOutput("nbt4_12")),
tags$li(textOutput("nbt4_13")),
tags$li(textOutput("nbt4_14"))
)
)
)
),
tabItem(
"batchmode",
fluidRow(
column(
4,
fileInput(
"bFile",
label = "Upload Batchmode File",
accept = c("text/csv","text/comma-separated-values",".csv"),
multiple = TRUE
)
),
column(
8,
style = 'margin-top: 25px;',
bsButton(
'runBFile',
'Run Batchmode'
# ,block = TRUE
# style = 'primary',
,width = '300px'
)
)
),
fluidRow(
DT::dataTableOutput('bDT')
# uiOutput('batchmodeDT')
)
)
)
),
rightsidebar = rightSidebar(
background = "dark",
rightSidebarTabContent(
id = 1,
# title = "Tab 1",
# icon = "desktop",
icon = "",
active = TRUE
,uiOutput('c1Viewer')
)
)
),
tags$script( # Opens the right sidebar by default
"$('body').addClass('control-sidebar-open');"
)
),
server = function(input, output) {
data("Endpoint", package = "ClearanceTool")
data("Structures", package = "ClearanceTool")
data("SubstanceIdentifiers", package = "ClearanceTool")
#set a dummy reactive variable
mol <<- reactiveValues(moleculedata = NULL)
#function to update the value based on changes on the shiny side
observeEvent(input$moleculedata, {
moljson <<- input$moleculedata
shinyjs::logjs(paste('input$moleculedata:',moljson))
mol$moleculedata <- processChemDoodleJson(moljson)
})
# output function simply tallies the atom counts
output$smiles <- renderText({
if (is.null(mol$moleculedata)){
return("Choose a Molecule and Click the Button!")
} else {
smiles <- toSmiles(mol$moleculedata)
return(paste("Smiles:", smiles))
}
})
observeEvent(input$runBFile, {
if(is.null(input$bFile)){
return(NULL)
} else{
batchmodeSmiles <<- data.frame(read_csv(input$bFile$datapath, col_names = F))
smilesV <- batchmodeSmiles[,1]
myPredictions <<- multipleChemicalPrediction(smilesCharacterVector = smilesV)#, databaseLocation = "Database.sqlite")
# output$batchmodeDT <- renderUI(
# tagList(
# SDFDataTable(myPredictions)
# )
# )
output$bDT <- renderDataTable(SDFDataTable(myPredictions))
}
})
observeEvent(input$done,{
withProgress(
message = 'Running chemical',
value = 0,
expr = {
tryCatch({
# n <- 10
# for(i in 1:n){
# incProgress(1/n, detail = paste("Doing part", i))
# Sys.sleep(10)
# }
molData <<- mol$moleculedata
chem1 <<- toSmiles(mol$moleculedata)
setProgress(0.2)
shinyjs::logjs("hello")
# validate(
# need(
shinyjs::logjs(Structures[1,3])
myChemResults <<- singleChemicalPrediction(
# Endpoint_TABLE_CT = Endpoint,
# Structures_TABLE_CT = Structures,
# SubstanceIdentifiers_TABLE_CT = SubstanceIdentifiers,
smilesString = chem1
)#, databaseLocation = paste0(system.file("ClearanceTool"),"Database.sqlite"))#"Database.sqlite")
# output$errorChecking <- renderPrint(myChemResults$errChecking)
# )
# )
# myChemResults <<- singleChemicalPrediction(smilesString = chem1, databaseLocation = "Database.sqlite")
myChem <<- myChemResults$testChemicalResult #testChemical
setProgress(0.8)
# myError <<- myChemResults$errChecking
# output$errorChecking <- renderPrint(myError)
fourChemicals <<- myChemResults$fourNearestNeighbors
nb1 <<- fourChemicals[1,]
nb2 <<- fourChemicals[2,]
nb3 <<- fourChemicals[3,]
nb4 <<- fourChemicals[4,]
output$myChem_1 <- renderText(
myChem[,1]
)
output$myChem_2 <- renderText(
paste(colnames(myChem)[2], ': ', myChem[,2], sep = '')
)
output$myChem_3 <- renderText(
paste(colnames(myChem)[3], ': ', myChem[,3], sep = '')
)
output$myChem_4 <- renderText(
paste(colnames(myChem)[4], ': ', myChem[,4], sep = '')
)
output$myChem_5 <- renderText(
paste(colnames(myChem)[5], ': ', myChem[,5], sep = '')
)
output$myChem_6 <- renderText(
paste(colnames(myChem)[6], ': ', myChem[,6], sep = '')
)
output$myChem_7 <- renderText(
paste(colnames(myChem)[7], ': ', myChem[,7], sep = '')
)
output$myChem_8 <- renderText(
paste(colnames(myChem)[8], ': ', myChem[,8], sep = '')
)
output$myChem_9 <- renderText(
paste(colnames(myChem)[9], ': ', myChem[,9], sep = '')
)
output$myChem_10 <- renderText(
paste(colnames(myChem)[10], ': ', myChem[,10], sep = '')
)
output$myChem_11 <- renderText(
paste(colnames(myChem)[11], ': ', myChem[,11], sep = '')
)
output$myChem_12 <- renderText(
paste(colnames(myChem)[12], ': ', myChem[,12], sep = '')
)
output$myChem_13 <- renderText(
paste(colnames(myChem)[13], ': ', myChem[,13], sep = '')
)
output$nbt1_2 <- renderText(
nb1[,2]
)
output$nbt1_3 <- renderText(
paste(colnames(nb1)[3], ': ', nb1[,3], sep = '')
)
output$nbt1_4 <- renderText(
paste(colnames(nb1)[4], ': ', nb1[,4], sep = '')
)
output$nbt1_5 <- renderText(
paste(colnames(nb1)[5], ': ', nb1[,5], sep = '')
)
output$nbt1_6 <- renderText(
paste(colnames(nb1)[6], ': ', nb1[,6], sep = '')
)
output$nbt1_7 <- renderText(
paste(colnames(nb1)[7], ': ', nb1[,7], sep = '')
)
output$nbt1_8 <- renderText(
paste(colnames(nb1)[8], ': ', nb1[,8], sep = '')
)
output$nbt1_9 <- renderText(
paste(colnames(nb1)[9], ': ', nb1[,9], sep = '')
)
output$nbt1_10 <- renderText(
paste(colnames(nb1)[10], ': ', nb1[,10], sep = '')
)
output$nbt1_11 <- renderText(
paste(colnames(nb1)[11], ': ', nb1[,11], sep = '')
)
output$nbt1_12 <- renderText(
paste(colnames(nb1)[12], ': ', nb1[,12], sep = '')
)
output$nbt1_13 <- renderText(
paste(colnames(nb1)[13], ': ', nb1[,13], sep = '')
)
output$nbt1_14 <- renderText(
paste(colnames(nb1)[14], ': ', nb1[,14], sep = '')
)
output$nbt2_2 <- renderText(
nb2[,2]
)
output$nbt2_3 <- renderText(
paste(colnames(nb2)[3], ': ', nb2[,3], sep = '')
)
output$nbt2_4 <- renderText(
paste(colnames(nb2)[4], ': ', nb2[,4], sep = '')
)
output$nbt2_5 <- renderText(
paste(colnames(nb2)[5], ': ', nb2[,5], sep = '')
)
output$nbt2_6 <- renderText(
paste(colnames(nb2)[6], ': ', nb2[,6], sep = '')
)
output$nbt2_7 <- renderText(
paste(colnames(nb2)[7], ': ', nb2[,7], sep = '')
)
output$nbt2_8 <- renderText(
paste(colnames(nb2)[8], ': ', nb2[,8], sep = '')
)
output$nbt2_9 <- renderText(
paste(colnames(nb2)[9], ': ', nb2[,9], sep = '')
)
output$nbt2_10 <- renderText(
paste(colnames(nb2)[10], ': ', nb2[,10], sep = '')
)
output$nbt2_11 <- renderText(
paste(colnames(nb2)[11], ': ', nb2[,11], sep = '')
)
output$nbt2_12 <- renderText(
paste(colnames(nb2)[12], ': ', nb2[,12], sep = '')
)
output$nbt2_13 <- renderText(
paste(colnames(nb2)[13], ': ', nb2[,13], sep = '')
)
output$nbt2_14 <- renderText(
paste(colnames(nb2)[14], ': ', nb2[,14], sep = '')
)
output$nbt3_2 <- renderText(
nb3[,2]
)
output$nbt3_3 <- renderText(
paste(colnames(nb3)[3], ': ', nb3[,3], sep = '')
)
output$nbt3_4 <- renderText(
paste(colnames(nb3)[4], ': ', nb3[,4], sep = '')
)
output$nbt3_5 <- renderText(
paste(colnames(nb3)[5], ': ', nb3[,5], sep = '')
)
output$nbt3_6 <- renderText(
paste(colnames(nb3)[6], ': ', nb3[,6], sep = '')
)
output$nbt3_7 <- renderText(
paste(colnames(nb3)[7], ': ', nb3[,7], sep = '')
)
output$nbt3_8 <- renderText(
paste(colnames(nb3)[8], ': ', nb3[,8], sep = '')
)
output$nbt3_9 <- renderText(
paste(colnames(nb3)[9], ': ', nb3[,9], sep = '')
)
output$nbt3_10 <- renderText(
paste(colnames(nb3)[10], ': ', nb3[,10], sep = '')
)
output$nbt3_11 <- renderText(
paste(colnames(nb3)[11], ': ', nb3[,11], sep = '')
)
output$nbt3_12 <- renderText(
paste(colnames(nb3)[12], ': ', nb3[,12], sep = '')
)
output$nbt3_13 <- renderText(
paste(colnames(nb3)[13], ': ', nb3[,13], sep = '')
)
output$nbt3_14 <- renderText(
paste(colnames(nb3)[14], ': ', nb3[,14], sep = '')
)
output$nbt4_2 <- renderText(
nb4[,2]
)
output$nbt4_3 <- renderText(
paste(colnames(nb4)[3], ': ', nb4[,3], sep = '')
)
output$nbt4_4 <- renderText(
paste(colnames(nb4)[4], ': ', nb4[,4], sep = '')
)
output$nbt4_5 <- renderText(
paste(colnames(nb4)[5], ': ', nb4[,5], sep = '')
)
output$nbt4_6 <- renderText(
paste(colnames(nb4)[6], ': ', nb4[,6], sep = '')
)
output$nbt4_7 <- renderText(
paste(colnames(nb4)[7], ': ', nb4[,7], sep = '')
)
output$nbt4_8 <- renderText(
paste(colnames(nb4)[8], ': ', nb4[,8], sep = '')
)
output$nbt4_9 <- renderText(
paste(colnames(nb4)[9], ': ', nb4[,9], sep = '')
)
output$nbt4_10 <- renderText(
paste(colnames(nb4)[10], ': ', nb4[,10], sep = '')
)
output$nbt4_11 <- renderText(
paste(colnames(nb4)[11], ': ', nb4[,11], sep = '')
)
output$nbt4_12 <- renderText(
paste(colnames(nb4)[12], ': ', nb4[,12], sep = '')
)
output$nbt4_13 <- renderText(
paste(colnames(nb4)[13], ': ', nb4[,13], sep = '')
)
output$nbt4_14 <- renderText(
paste(colnames(nb4)[14], ': ', nb4[,14], sep = '')
)
output$singleChem <- renderUI(
tagList(
chemdoodle_viewer(chem1, width = 550, height = 380, {scale = 100})
# ,tags$script('console.log("hello");')#, scale = 20)
)
)
output$c1Viewer <- renderUI(
tagList(
chemdoodle_viewer(chem1, width = 200, height = 200)#, {scale = 50})
)
)
output$neighbor1 <- renderUI(
tagList(
fluidRow(
align = 'center',
chemdoodle_viewer(nb1$SMILES, width = 200, height = 200)#, {scale = 50})
)
)
)
output$neighbor2 <- renderUI(
tagList(
fluidRow(
align = 'center',
chemdoodle_viewer(nb2$SMILES, width = 200, height = 200)#, {scale = 50})
)
)
)
output$neighbor3 <- renderUI(
tagList(
fluidRow(
align = 'center',
chemdoodle_viewer(nb3$SMILES, width = 200, height = 200)#, {scale = 14.4})
)
)
)
output$neighbor4 <- renderUI(
tagList(
fluidRow(
align = 'center',
chemdoodle_viewer(nb4$SMILES, width = 200, height = 200)#, {scale = 50})
)
)
)
setProgress(1)
})
error = function(e) {
shinyalert("Failed to process your chemical.", conditionMessage(e), type = "error", closeOnClickOutside = TRUE)
}})
})
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.