inst/app.R

# Temp copy of origanl app.R for reference
## app.R ##
library(tidyverse)

.libPaths(c(normalizePath("./libs"), .libPaths())) 
library(tern)

library(shiny)
library(shinyjs)
library(shinydashboard)
library(readxl)
library(shinyWidgets)
library(DT)
library(haven)
library(shinyBS)
library(dplyr) 
library(jsonlite)
library(DBI)

global_path<<-"/opt/bee_tools/shiny/3.5.3/users/remusatp/Global/"
main_path<<-"/opt/bee_tools/shiny/3.5.3/users/remusatp/lopo3000/"
functionPath<<-paste0(main_path,"functions/")
#study<<-"YO39609"
#study<<-"WO39392"
study<<-"BP40657"
status<<-"Interim 1"
server_<-"BEE"
userff <- Sys.info()["user"]
source("functions/callB_func.R")
source("functions/execute_R_prog.R")
source("functions/filters.R")
options(shiny.sanitize.errors = TRUE)


########get study list#################  
con_1 <- dbConnect(RSQLite::SQLite(), paste0(global_path,"userDB"))

getStudy_list <- function() {
  res <-  dbSendQuery(con_1, "SELECT * FROM UserDB  where user ='remusatp' ")
  study_list <- dbFetch(res)
  dbClearResult(res)
  return(study_list)
}

#####################################







######################################## UI PART ###########################################
############################################################################################
ui <- dashboardPage(
  
  dashboardHeader(title = paste0(study,"(",status,")") ), 
  ## Sidebar content
  dashboardSidebar(
    sidebarMenu(
      menuItem("Home",    tabName = "Home",     icon = icon("dashboard")),
      menuItem("Overview",tabName = "OVERVIEW", icon = icon("th")) ,
      menuItem("LOPO",    tabName = "LOPO",     icon = icon("th")) 
    )
  ),
  
  dashboardBody(
    tabItems(
      tabItem(tabName = "Home", 
              h2("Study Description") ,p(userff),
              p(textOutput("description")),
              h2("Path in BEE") ,
              p(textOutput("study_path"))
      ),
      
      tabItem(tabName = "OVERVIEW", 
              h1(paste0("Overview of Lopo for study ",study, "(",status,")") ) ,    
              
              valueBox(  textOutput("num_of_table"), "Tables", icon = icon("list"), color = "aqua", width = 3,
                         href = NULL),
              valueBox( textOutput("num_of_figure"), " Figures", icon = icon("chart-bar"), color = "aqua", width = 3,
                        href = NULL),
              valueBox( textOutput("num_of_listing"), " Listings", icon = icon("align-justify"), color = "aqua", width = 3,
                        href = NULL),
              valueBox("12", "ADAMs", icon = icon("plus-square"), color = "aqua", width = 3,
                       href = NULL) 
      ) ,
      
      tabItem(tabName = "LOPO", 
              ##  h1(study) , 
              
              div(style="display: inline-block;vertical-align:top; width: 300px;",   
                  
                  awesomeCheckboxGroup(
                    inputId = "OutType",
                    label = "Type of Output", 
                    choices = c("Table", "Listing", "Figure"),
                    inline = TRUE,
                    status = "danger"
                  )),
              
              
              div(style="display: inline-block;vertical-align:top; width: 330px;",           
                  pickerInput(
                    inputId = "DomainC",
                    label = "Select Domain", 
                    choices =  c( "AE", "Exposure", "Disposition", "Demography", "Deaths", "Con Med") ,
                    multiple = TRUE,
                    # selected = "NULL", 
                    choicesOpt = list(
                      content = sprintf("<span class='label label-%s'>%s</span>", 
                                        c("danger", "success", "warning", "info", "default","primary"), 
                                        c( "AE", "Exposure", "Disposition", "Demography","Deaths",  "Con Med"))) 
                  )),
              
              div(style="display: inline-block;vertical-align: center; width:100px;",      
                  tags$br(),
                  actionBttn(
                    inputId = "tabFilt",
                    label = "Filter",
                    color = "primary",
                    style = "simple",
                    size= "sm",
                    icon = icon("sliders"),
                    block = TRUE
                  ),
                  bsTooltip("tabFilt", "Edit Filters",
                            "top", options = list(container = "body")),  
                  "   ",
                  bsModal("modalFilter", "Filters", "tabFilt", size = "large",
                          dataTableOutput("filtTable"))
              ),
              
              useShinyjs(),
              extendShinyjs(text = js_code ),
              dataTableOutput('myLopo3000') ,  
              
              
              conditionalPanel(condition =  "output.lopoExist == 'NO' ", 
                               p("Lopo template must follow the standard you can find here"),
                               sidebarLayout(
                                 sidebarPanel(
                                   df<-fileInput('file1', 'Choose xlsx file', accept = c(".xls"))
                                 ),
                                 mainPanel( 
                                   tableOutput('contents') 
                                 ) 
                               ) )  ))  ) )

############################################################################################ 

###################################### SERVER PART #########################################

server <- function(input, output, session){
  
  output$lopoExist <- renderText('NO')
  
  observe({
    
    query <- parseQueryString(session$clientData$url_search)
    
    if (!is.null(query[['study']])) {
      study <- query[['study']]
    }
    
    if (!is.null(query[['server']])) {
      server_ <- query[['server']]
    }
    
    s_path<-paste0(main_path,"Studies/",study,"/",study)
    
    ########Study Information#########
    study_list<-getStudy_list()
    study_desc<-study_list[study_list[,"STUDY"]==study , 10]
    studyy_path<-study_list[study_list[,"STUDY"]==study , 7]
    
    output$description <- renderText( { study_desc  } )
    output$study_path <- renderText( { studyy_path  } )
    
    ##################################
    
    
    lopoPath <- paste0("Studies/",study,"/",study)
    
    if (server_ == "BEE") {
      # source("functions/datatable_R.R")
    }
    
    if (server_ == "Entimice") {
      source("functions/datatable_SAS.R")
    }
    
    
    if (checkLopo(lopoPath)=="OK") {
      
      myLopo <- getLopo(study,lopoPath)  
      
      num_of_table<- count(myLopo[myLopo['outType']=="Table",],)
      num_of_figure<-count(myLopo[myLopo['outType']=="Figure",],)
      num_of_listing<-count(myLopo[myLopo['outType']=="Listing",],)
      
      output$num_of_table <- renderText({paste0(num_of_table, "")})
      output$num_of_figure <- renderText({paste0(num_of_figure, "")})
      output$num_of_listing <- renderText({ paste0(num_of_listing, "")})
      
      
      
      
      print(num_of_table)
      
      #-----------------------------------------------------------------------------
      #  Filter outputs list 
      #-----------------------------------------------------------------------------
      
      col_list<-c('See', 'Action' , 'Domain', 'Titles', 'Footnotes', 'Filters', 'GDS Template', 'Program ID','outType','CRUD','idbis')
      myLopotmp<-myLopo
      myLopotmp$CRUD<-"Edit - Delete"
      
      values <- reactiveValues(dfWorking = myLopotmp)
      
      result <- shiny::reactiveValues()
      result$thedata <- myLopotmp[,col_list]
      result$view.cols <- names(myLopotmp[,col_list])
      result$edit.cols <- names(myLopotmp[,col_list])
      result$edit.label.cols <- result$edit.cols
      edit.cols  <- names(myLopotmp[,col_list])
      edit.label.cols  <- names(myLopotmp[,col_list])
      
      
      ####================================================================================================####
      ####                                 Display an Interactif LOPO                                     ####
      ####================================================================================================####
      output$myLopo3000 <- renderDataTable( {
        ##values$dfWorking
        
        if ( is.null(input$DomainC)   && is.null(input$OutType) )  {
          values$dfWorking[,col_list]  }
        else if  (is.null(input$DomainC))  {
          values$dfWorking[,col_list] %>% filter(outType  %in% c( input$OutType)) 
        }
        else if  (is.null(input$OutType))  {
          values$dfWorking[,col_list] %>% filter(Domain  %in% c( input$DomainC)) 
        }
        else {
          values$dfWorking[,col_list] %>% filter(Domain  %in% c( input$DomainC) ) %>% filter(outType  %in% c( input$OutType) )
        }
      }, 
      options = list(
        dom = 't',
        initComplete = JS(
          "function(settings, json) {",
          "$(this.api().table().header()).css({'background-color': 'lightgrey', 'color': '#000', 'font-size': '10px' });",
          "$(this.api().table().body()).css({   'font-size': '12px',   'text-align': 'center' });",
          "}"), 
        
        searchHighlight = TRUE,
        columnDefs = list(
          list(targets=2, 
               render = JS(paste0( "function(data, type, row, meta) {",
                                   "if (data == 'AE') {",
                                   "return '<small class=\"badge pull-center bg-red\">' + data + ' </small>' }",
                                   "else if (data == 'Disposition') {",
                                   "return '<small class=\"badge pull-center bg-yellow\">' + data + ' </small>' }",
                                   "else if (data == 'Exposure') {",
                                   "return '<small class=\"badge pull-center bg-green\">' + data + ' </small>' }",
                                   "else if (data == 'Demography') {",
                                   "return '<small class=\"badge pull-center bg-teal\">' + data + ' </small>' }",
                                   "else if (data == 'Con Med') {",
                                   "return '<small class=\"badge pull-center bg-blue\">' + data + ' </small>' }",
                                   "else if (data == 'Death') {",
                                   "return '<small class=\"badge pull-center bg-grey\">' + data + ' </small>' }",
                                   "else  {",
                                   "return '<small class=\"badge pull-center bg-violet\">' + data + ' </small>' }",
                                   "}"))),
          
          
          list(targets=9, 
               render = JS(paste0( "function(data, type, row, meta) {",
                                   "return '",
                                   "<table>",
                                   "<td align=\"center\"> <button id=\"button_'+ row[10] +'\"   class=\"btn btn-primary btn-xs \" style=\"font-size:7px \" onclick=\"Shiny.onInputChange(&quot;edit_button&quot;, this.id + &quot;_&quot; + Math.random())\">Edit</button> </td>",
                                   "<td align=\"center\"> <button id=\"buttonss_'+ row[10] +'\" class=\"btn btn-danger btn-xs\" style=\"font-size:7px \" onclick=\"Shiny.onInputChange(&quot;del_button&quot;, this.id + &quot;_&quot; + Math.random())\">Delete</button> </td>",
                                   "</table>'  }"
               ))),
          
          list(targets=10,visible=FALSE),
          
          
          list(targets=0, 
               render = JS(paste0( "function(data, type, row, meta) {",
                                   "if (data == 'NA') {", 
                                   "return ' <i id=\"buttonss_'+ row[10] +'\" class=\"far fa-times-circle text-danger \" style=\"font-size:30px \" ></i>' }",
                                   "else  {",
                                   "return ' <i id=\"buttonsst_'+ row[10] +'\" class=\"far fa-file-alt text-success \"   style=\"font-size:30px \"  onclick=\"Shiny.onInputChange(&quot;see_button&quot;, this.id + &quot;_&quot; + Math.random())\"></i> ' }",
                                   "}"))),    
          
          list(targets=1, 
               render = JS(paste0( "function(data, type, row, meta) {",
                                   "if (data == 'PROG_OK') {", 
                                   "return ' <i id=\"buttonbb_'+ row[10] +'\" class=\"fas fa-arrow-alt-circle-right text-success \" style=\"font-size:30px \" onclick=\"Shiny.onInputChange(&quot;run_button&quot;, this.id + &quot;_&quot; + Math.random() )\"></i> ' }",
                                   "else  {",
                                   "return ' <i id=\"buttonbbt_'+ row[10] +'\" class=\"fas fa-arrow-circle-up text-danger \"   style=\"font-size:30px \"  onclick=\"Shiny.onInputChange(&quot;create_button&quot;, this.id + &quot;_&quot; + Math.random() )\"></i>' }",
                                   "}"))),   
          
          
          list(targets = c(1,0),width = '20px'),
          list(targets = c(3,4),width = '150px'),
          list(targets = c(2, 5,6,7,8,9),width = '50px'),
          list(targets = c(10),width = '10px'),
          list(targets = c(4,5,3),
               render = JS("function(data, type, row, meta) {",
                           "return type === 'display' && data.length > 50 && data  ?",
                           "'<p align=\"left\"><span title=\"' +  data + '\">' + data.substr(0, 50) + '...</span></p>' : '<p align=\"left\">' + data + '</p>' ;",
                           "}")  ) 
        ),
        scrollY = 600, 
        scroller = TRUE,
        scrollX = T,
        pageLength = 25
      ) , 
      extensions = c('Buttons','Responsive'), server=TRUE,  selection='single', rownames=FALSE)     
      
      ####================================================================================================####
      ####                           End of  Display an Interactif LOPO                                   ####
      ####================================================================================================####         
      
      #-----------------------------------------------------------------------------
      #  button functionalities
      #-----------------------------------------------------------------------------
      
      
      observeEvent(input$see_button, {
        selectedRow <- as.numeric(strsplit(input$see_button, "_")[[1]][2])
        outputid<-selectedRow
        js$browseURL(paste0("https://shiny.roche.com/3.5.3/users/remusatp/output3000/?outputid=",outputid,"&study=",study,"&server=",server_))
        
      } )
      
      observeEvent(input$run_button, {
        selectedRow <- as.numeric(strsplit(input$run_button, "_")[[1]][2])
        print(selectedRow)
        execute_R_prog(study,lopoPath,selectedRow)
        
      })
      
      
      observeEvent(input$seeb, {
        outputid <- as.numeric(strsplit(input$seeb, "_")[[1]][2])
        js$browseURL(paste0("https://shiny.roche.com/3.5.3/users/remusatp/output3000/?outputid=",outputid,"&study=",study,"&server=",server_))
      })
      
      
      ####Create single program onclick
      
      observeEvent(input$create_button, {
        s_path<-paste0(main_path,"Studies/",study,"/",study)
        selectedRow <- as.numeric(strsplit(input$create_button, "_")[[1]][2])
        metaOutput<-getOutput(study,s_path,selectedRow) 
        create_R_program(paste0("Studies/",study,"/program/"),metaOutput$`Program ID`,"test")
        
        ##check_prog_exisit(paste0("Studies/",study,"/program/",metaOutput$`Program ID`))
        ##if prog exisit , update database
        
        showModal(modalDialog(
          title = "Program created",
          "Program have been created",
          easyClose = TRUE
        ))
        
        myLopo<-getLopo(studyl,lopoPath)
        js$reset()
      })
      
      
      # Updates goButton's label and icon
      updateActionButton(session, "goButton",
                         label = "New label",
                         icon = icon("calendar"))
      
      
      
      ################General Button related to lopo#################
      ####################################################################
      ###Create Program related to lopo output############################
      ####################################################################
      
      source("functions/createRprog.R")
      
      vect_prog_name<-myLopo$`Program ID`
      progPath<-paste0("Studies/",study,"/program/")
      observeEvent(input$Create, {
        create_all_R_program(progPath,vect_prog_name)
        showModal(modalDialog(
          title = "Job Done",
          "Program have been created",
          easyClose = TRUE
        ))
        
      })
      
      
      source("functions/template_meta_titles.R")
      source("functions/template_meta_footnotes.R") 
      
      observeEvent(input$Export, {
        
        createTitleFile(study,"PROJECT A",userff,"IMC")
        createFootnoteFile(study,"PROJECT A",userff,"IMC")
        
        showModal(modalDialog(
          title = "Job Done",
          "Titles and footnote have been exported",
          easyClose = TRUE
        ))
        
      })
      
      
      ####################################################################
      #####################Check and Edit Filters#########################
      ####################################################################    
      
      filters_path <<- paste0(main_path,"Studies/",study,"/meta/FILTERS")
      
      tab <- getFilters(filters_path)
      output$filtTable <- renderDataTable({ tab
      }, options = list( dom='t'), editable = TRUE  )
      
      
      
      # edit a single cell
      proxy5 = dataTableProxy('filtTable')
      
      observeEvent(input$filtTable_cell_edit, {
        
        info = input$filtTable_cell_edit
        str(info)  # check what info looks like (a data frame of 3 columns)
        tab <<- editData(tab, input$filtTable_cell_edit )
        
        
        ###update database
        
        con <- dbConnect(RSQLite::SQLite(), paste0("Studies/",study,"/meta/FILTERS"))
        dbWriteTable(con, "FILTERS", tab, overwrite=TRUE)
        #dbBind(update, tab)  # send the updated data
        # dbClearResult(update)  # release the prepared statement
        dbDisconnect(con)
        
      })    
      
      
      ##############################################################################################################################################################################
      ##############################################################################################################################################################################
      ##############################################################################################################################################################################
      ##############################################################################################################################################################################
      
      
      
      
      
      
      ####================================================================================================####
      ####                                CRUD Functionalities                                            ####
      ####================================================================================================####
      
      ##====================================================================##
      ##==============================##DELETE##==============================##
      ##====================================================================##
      source("functions/CRUD.R")
      
      observeEvent(input$del_button, {
        selectedIDBIS <- as.numeric(strsplit(input$del_button, "_")[[1]][2])
        deleteModal(selectedIDBIS,result)
      })
      
      observeEvent(input$buttonClicked,{
        if (!is.null(input$buttonClicked)) {
          values$dfWorking <- values$dfWorking[  values$dfWorking[,"idbis"] != input$buttonClicked ,]
          ##REMOVE ROW FROM DATABASE (LOPO)
          con <- dbConnect(RSQLite::SQLite(),  paste0("Studies/",studyl,"/",studyl))
          query <- paste0('DELETE FROM  ',studyl,'  WHERE rowid = ', input$buttonClicked)
          dbSendQuery(con, query)
          dbDisconnect(con)
          
          shiny::removeModal()
        }
      })
      
      ##====================================================================##
      ##==============================##EDIT##==============================##
      ##====================================================================##
      valid.input.types <- c('dateInput', 'selectInput', 'numericInput',
                             'textInput', 'textAreaInput', 'passwordInput', 'selectInputMultiple')
      
      inputTypes <- sapply(result$thedata[,edit.cols], FUN=function(x) {
        switch(class(x),
               list = 'selectInputMultiple',
               character = 'textInput',
               Date = 'dateInput',
               factor = 'selectInput',
               integer = 'numericInput',
               numeric = 'numericInput')
      })
      
      input.types = c(Footnotes ='textAreaInput',Titles ='textAreaInput')
      
      if(!missing(input.types)) {
        if(!all(names(input.types) %in% edit.cols)) {
          stop('input.types column not a valid editting column: ',
               paste0(names(input.types)[!names(input.types) %in% edit.cols]))
        }
        if(!all(input.types %in% valid.input.types)) {
          stop(paste0('input.types must only contain values of: ',
                      paste0(valid.input.types, collapse = ', ')))
        }
        inputTypes[names(input.types)] <- input.types
      }
      
      
      # Convert any list columns to characters before displaying
      for(i in 1:ncol(result$thedata)) {
        if(nrow(result$thedata) == 0) {
          result$thedata[,i] <- character()
        } else if(is.list(result$thedata[,i])) {
          result$thedata[,i] <- sapply(result$thedata[,i], FUN = function(x) { paste0(x, collapse = ', ') })
        }
      }
      
      
      getFields <- function(typeName, valuestmp ) {
        fields <- list()
        for(i in seq_along(edit.cols)) {
          if(inputTypes[i] == 'dateInput') {
            value <- ifelse(missing( valuestmp),
                            as.character(Sys.Date()),
                            as.character( valuestmp[,edit.cols[i]]))
            fields[[i]] <- dateInput(paste0("myLopo", typeName, edit.cols[i]),
                                     label=edit.label.cols[i],
                                     value=value,
                                     width=date.width)
          } else if(inputTypes[i] == 'selectInputMultiple') {
            value <- ifelse(missing( valuestmp), '',  valuestmp[,edit.cols[i]])
            if(is.list(value)) {
              value <- value[[1]]
            }
            choices <- ''
            if(!missing( valuestmp)) {
              choices <- unique(unlist( valuestmp[,edit.cols[i]]))
            }
            if(!is.null(input.choices)) {
              if(edit.cols[i] %in% names(input.choices)) {
                choices <- input.choices[[edit.cols[i]]]
              }
            }
            if(length(choices) == 1 & choices == '') {
              warning(paste0('No choices available for ', edit.cols[i],
                             '. Specify them using the input.choices parameter'))
            }
            fields[[i]] <- selectInputMultiple(paste0("myLopo", typeName, edit.cols[i]),
                                               label=edit.label.cols[i],
                                               choices=choices,
                                               selected=value,
                                               width=select.width)
            
          } else if(inputTypes[i] == 'selectInput') {
            value <- ifelse(missing( valuestmp), '', as.character( valuestmp[,edit.cols[i]]))
            fields[[i]] <- shiny::selectInput(paste0("myLopo", typeName, edit.cols[i]),
                                              label=edit.label.cols[i],
                                              choices=levels(result$thedata[,edit.cols[i]]),
                                              selected=value,
                                              width=select.width)
          } else if(inputTypes[i] == 'numericInput') {
            value <- ifelse(missing( valuestmp), 0,  valuestmp[,edit.cols[i]])
            fields[[i]] <- shiny::numericInput(paste0("myLopo", typeName, edit.cols[i]),
                                               label=edit.label.cols[i],
                                               value=value,
                                               width=numeric.width)
          } else if(inputTypes[i] == 'textAreaInput') {
            value <- ifelse(missing( valuestmp), '',  valuestmp[,edit.cols[i]])
            fields[[i]] <- shiny::textAreaInput(paste0("myLopo", typeName, edit.cols[i]),
                                                label=edit.label.cols[i],
                                                value=value,
                                                width=textarea.width, height=textarea.height)
          } else if(inputTypes[i] == 'textInput') {
            value <- ifelse(missing( valuestmp), '',  valuestmp[,edit.cols[i]])
            fields[[i]] <- shiny::textInput(paste0("myLopo", typeName, edit.cols[i]),
                                            label=edit.label.cols[i],
                                            value=value,
                                            width=text.width)
          } else if(inputTypes[i] == 'passwordInput') {
            value <- ifelse(missing( valuestmp), '',  valuestmp[,edit.cols[i]])
            fields[[i]] <- shiny::passwordInput(paste0("myLopo", typeName, edit.cols[i]),
                                                label=edit.label.cols[i],
                                                value=value,
                                                width=text.width)
          } else {
            stop('Invalid input type!')
          }
        }
        return(fields)
      }
      
      
      
      
      #####EDit a line of LOPO#######
      ###1 Click on EDit button on a line
      
      observeEvent(input$edit_button, {
        input.types <- c(Footnotes ='textAreaInput',Titles ='textAreaInput') 
        selectedIDBIS <- as.numeric(strsplit(input$edit_button, "_")[[1]][2])
        print(input$edit_button)
        editModal(selectedIDBIS)
      })  
      
      
      
      ###2 Display a Modal to update(edit) the line of the LOPO
      
      editModal <- function(selectedRow ) {
        
        jscode_edit <- paste0( '
        $("#lopo_update").on("click", function(){
        Shiny.onInputChange("editClicked",', selectedRow  , '+ "_" + Math.random()',');
        })
        ')
        
        #output[['myoutput_message']] <- renderText('')
        fields <- getFields('_edit_', values=values$dfWorking[values$dfWorking[,"idbis"]==selectedRow,] )
        
        showModal(modalDialog(title = "Edit",
                              shiny::div(shiny::textOutput('myoutput_message'), style='color:red'),
                              fields,
                              footer = column(shiny::modalButton('Cancel'),
                                              shiny::actionButton("lopo_update", 'Save'),
                                              width=12),
                              tags$script(HTML(jscode_edit)) ,
                              size =  'm',  ##modal.size
                              easyClose = TRUE
        ))
      }
      
      
      ###3 Update the databse when we click on the save button of the Modal 
      
      observeEvent(input$editClicked,{
        if (!is.null(input$editClicked)) {
          
          ## selectedRow<-input$editClicked[[]]
          selectedRow<-as.numeric(strsplit(input$editClicked, "_")[[1]][1])
          print("kikou")
          print(selectedRow)
          print("kikou_Stop")
          newdata <- result$thedata
          newdata[newdata[,"idbis"]==selectedRow, names(newdata) != "idbis"] <- NA
          
          ###Update here with the correct row (idbis)  newdata[,"idbis"]==row  )
          for(i in edit.cols) {
            if(inputTypes[i] %in% c('selectInputMultiple')) {
              newdata[[i]][newdata[,"idbis"]==selectedRow] <- list(input[[paste0('myLopo_edit_', i)]])
            } else {
              newdata[newdata[,"idbis"]==selectedRow,i] <- input[[paste0('myLopo_edit_', i)]]
            }
          }
          
          data<-newdata[newdata[,"idbis"]==selectedRow, ]
          values$dfWorking <- newdata
          
          ###Update LOPO DB###
          con <- dbConnect(RSQLite::SQLite(),  paste0("Studies/",study,"/",study))
          query <- paste0("UPDATE  ",study,"  SET ",
                          "Domain = '",  as.character(data$Domain), "', ",
                          "Titles = '", as.character(data$Titles), "', ",
                          "Footnotes = '",  as.character(data$Footnotes), "', ",
                          "Filters = '", as.character(data$Filters), "' ",
                          "WHERE rowid = ", selectedRow)
          print(query)
          dbSendQuery(con, query)
          dbDisconnect(con)
          
          ###Close Modal ###
          shiny::removeModal()
        }
      })
      
      
      ######################################################################
      
      output$lopoExist <- renderText('YES')
      
    }
    
    
    #####LOPO Not yet CReated 
    else {
      output$lopoExist <- renderText('NO')
      
      
      #-----------------------------------------------------------------------------
      #  import a lopo 
      #-----------------------------------------------------------------------------
      
      output$contents <-    renderTable({
        inFile <- input$file1
        if(is.null(inFile))return(NULL)
        file.rename(inFile$datapath,paste(inFile$datapath, ".xls", sep=""))
        newLopo <-readxl::read_excel(paste(inFile$datapath, ".xls", sep=""), sheet="List of Planned Outputs (SMT)",skip = 6)
        ###remove empty rows (title and Footnote)
        newLopo <- newLopo %>% filter_at(vars(Titles,Footnotes),any_vars(!is.na(.)))
        newLopo$Study <- study
        newLopo$Select = "Select"
        newLopo$Action = "Action"
        newLopo$idbis <- rownames(newLopo)
        len_newLopo<-dim(newLopo)[1]
        newLopo0<-newLopo
        newLopo<-newLopo0[c(dim(newLopo)[2], 1:(dim(newLopo)[2]-1))]
        #newLopo<-newLopo[1:25,]
        newLopo[is.na(newLopo)] <- ''
        newLopo$See = "NA"
        newLopo$Run = "Run" 
        newLopo<-mutate(newLopo,outType=ifelse(substr(newLopo$`Outputs Produced`, 1, 1)=="t","Table",ifelse(substr(newLopo$`Outputs Produced`, 1, 1)=="l","Listing",ifelse(substr(newLopo$`Outputs Produced`, 1, 1)=="f","Figure","Other"))))
        
        ####Lopo as a SQL database  ####
        con <- dbConnect(RSQLite::SQLite(), lopoPath)
        dbCreateTable(con, study, newLopo)
        dbAppendTable(con, study, newLopo)
        dbReadTable(con, study)
        dbDisconnect(con)
        
        
        ####Create arelated Filters list  ####
        
        filterLopo<<-unique(newLopo$Filters)
        source("functions/filters.R")  ##load the main filter db
        
        filts<-unique(df_filter[,"filts"])
        
        
        f_ok <- c()
        f_not_ok <- c()
        for  (f in filterLopo) {
          f_split <- strsplit(f,"_")
          
          for (fs in f_split[[1]] ) {
            
            if (fs %in%  filts) {
              f_ok <- c(f_ok,  fs) 
            }
            else {
              f_not_ok<- c(f_not_ok,  fs)
            }
          }
        }
        
        #CASE 1 : The filter exists in the main database
        df_ok<-df_filter[df_filter[,"filts"] %in% unique(f_ok), ]
        
        #CASE 2 : The filter does'nt exist in the main database
        df_not_ok<- data.frame(  "filts" = unique(f_not_ok)   )
        df_not_ok$title<-""
        df_not_ok$filter<-""
        
        filter_tmp <- rbind(df_ok,df_not_ok)
        
        # Create  filter DB (study related)
        
        con <- dbConnect(RSQLite::SQLite(), filters_path)
        dbCreateTable(con, "FILTERS", filter_tmp)
        dbAppendTable(con, "FILTERS", filter_tmp)
        dbReadTable(con, "FILTERS")
        dbDisconnect(con)  
        
      })
      
      
      # data_path<-getDataPath(study,as.character(userff))
      
      
      #######ACtion button to import Enimice data##################
      # observeEvent(input$Import, {
      
      #  SAICE::initialize_connection(entimice_env = "PROD")
      
      #   adsl         <- SAICE::read_entimice(file.path(paste0("root/clinical_studies/",data_path,'work/work/outdata_vad/adsl.sas7bdat')))
      #  output_list  <- SAICE::get_entimice(paste0("root/clinical_studies/",data_path,"work/work/output")) 
      # program_list <- SAICE::get_entimice(paste0("root/clinical_studies/",data_path,"work/work/program")) 
      #log_list     <- SAICE::get_entimice(paste0("root/clinical_studies/",data_path,"work/work/log")) 
      
      #  SAICE::close_connection()
      
      # })
      #############################################################
      
      
    }
    
    outputOptions(output, 'lopoExist', suspendWhenHidden = FALSE)
    #-----------------------------------------------------------------------------
    #  end of server 
    #----------------------------------------------------------------------------- 
    
  }) }


############################################################################################ 

shinyApp(ui, server)
kismet303/lopo3000 documentation built on Dec. 5, 2019, 8:40 a.m.