inst/CTApp/app.R

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)
    }})

    })
    
  }
)
ScitoVation/ClearanceTool documentation built on Dec. 16, 2019, 10:49 p.m.