ScreenHandle.R

#' ScreenHandle
#' @description Object for handling database operations related to the storage and 
#' retrieval of Screen objects.
#' @field dbConnection A dbConnection object
#' @export
ScreenHandle <- R6Class(
  classname = "ScreenHandle",
  lock_class = TRUE,
  public = list(
    dbConnection = NULL,
    #' @description Create an object for handling database operations related to 
    #' the storage and retrieval of Screen objects.
    #' @param dbConnection A dbConnection object
    initialize = function(dbConnection = NA) {
      self$dbConnection <- dbConnection
    },
    #' @description Retrieve a Screen object using its database ID
    #' @param dbID Database ID of the Screen object to retrieve
    #' @return A Screen object
    get_by_id = function(dbID) {
      query <- "SELECT * FROM Screen WHERE ID = ?"
      df <- self$dbConnection$get_data(query, list(dbID))
      if(length(df$ID)>0) {
        screen <- Screen$new(dbConnection = self$dbConnection,
                             ID = df$ID,
                             name = df$name,
                             description = df$description,
                             status = df$status, 
                             date_started = df$date_started,
                             date_ended = df$date_ended)
        return(screen)
      } else { return(NULL) }
    },
    #' @description Retrieve the Screen object that contains a given plate
    #' @param plate A Plate object
    #' @return A Screen object
    get_by_plate = function(plate) {
      query <- "SELECT S.* FROM Screen AS S, Screen_has_Plate AS ShP 
                WHERE ShP.Plate_ID = ?
                AND ShP.Screen_ID = S.ID"
      df <- self$dbConnection$get_data(query, list(plate$ID))
      if(length(df$ID)>0) {
        screen <- Screen$new(dbConnection = self$dbConnection,
                             ID = df$ID,
                             name = df$name,
                             description = df$description,
                             status = df$status, 
                             date_started = df$date_started,
                             date_ended = df$date_ended)
        return(screen)
      } else { return(NULL) }
    },
    #' @description Retrieve all screens
    #' @return List of Screen objects
    get_all_screens = function() {
      query <- "SELECT DISTINCT ID FROM Screen"
      df <- self$dbConnection$get_data(query)
      if(length(df$ID)>0) {
        screens <- list()
        for(id in df$ID) {
          sc <- self$get_by_id(id)
          screens <- c(screens, sc)
        }
        return(screens)
      }
    },
    #' @description Retrieve all screens with the given name
    #' @param name A screen name
    #' @return List of Screen objects
    get_all_by_name = function(name) {
      query <- "SELECT DISTINCT ID FROM Screen WHERE name = ?"
      df <- self$dbConnection$get_data(query, list(name))
      if(length(df$ID)>0) {
        screens <- list()
        for(id in df$ID) {
          sc <- self$get_by_id(id)
          screens <- c(screens, sc)
        }
        return(screens)
      }
    },
    #' @description Retrieve all screens with the given status
    #' @param status One of unknown, planned, running, awaiting analysis, 
    #' completed, archived
    #' @return List of Screen objects
    get_all_by_status = function(status) {
      query <- "SELECT DISTINCT ID FROM Screen WHERE status = ?"
      df <- self$dbConnection$get_data(query, list(status))
      if(length(df$ID)>0) {
        screens <- list()
        for(id in df$ID) {
          sc <- self$get_by_id(id)
          screens <- c(screens, sc)
        }
        return(screens)
      }
    },
    #' @description Generate a database ID for a Screen object
    #' @return A string starting with the prefix SCR:
    get_new_ID = function() {
      query <- "SELECT seq FROM Screen ORDER BY seq DESC LIMIT 1"
      df <- self$dbConnection$get_data(query)
      if(nrow(df)>0) {
        ID <- paste0("SCR:", sprintf("%012d", df$seq+1))
      } else { # The table is empty
        ID <- paste0("SCR:", sprintf("%012d",1))
      }
      return(ID)
    },
    #' @description Store Screen objects in the database
    #' @param screen.list A list of Screen objects
    #' @param fast.mode (optional, default: FALSE) Speeds up data loading by
    #' disabling integrity checks
    store = function(screen.list, fast.mode = FALSE) {
      if(fast.mode) { # Disable integrity checks
        result <- self$dbConnection$execute("SET @@session.unique_checks = 0")
        result <- self$dbConnection$execute("SET @@session.foreign_key_checks = 0")
      }
      statement <- "INSERT IGNORE INTO Screen (ID, name, description, status, date_started, date_ended)
                                       VALUES (?, ?, ?, ?, ?, ?)" 
      for(screen in screen.list) {
        result <- self$dbConnection$execute(statement, list(screen$ID, 
                                                            screen$name,
                                                            screen$description,
                                                            screen$status,
                                                            screen$date_started,
                                                            screen$date_ended))
        if(length(screen$plates)>0) {
          plh <- PlateHandle$new(self$dbConnection)
          result <- plh$store(screen$plates)
          for(plate in screen$plates) {
            st <- "INSERT IGNORE INTO Screen_has_Plate (Screen_ID, Plate_ID)
                                                VALUES (?, ?)"
            r <- self$dbConnection$execute(st, list(screen$ID, plate$ID))
          }
        }
        if(length(screen$analyses)>0) {
          ah <- AnalysisHandle$new(self$dbConnection)
          result <- ah$store(screen$analyses)
          for(analysis in screen$analyses) {
            st <- "INSERT IGNORE INTO Screen_has_Analysis (Screen_ID, Analysis_ID)
                                                   VALUES (?, ?)"
            r <- self$dbConnection$execute(st, list(screen$ID, analysis$ID))
          }
        }
      }
      if(fast.mode) { # Re-enable integrity checks
        result <- self$dbConnection$execute("SET @@session.unique_checks = 1")
        result <- self$dbConnection$execute("SET @@session.foreign_key_checks = 1")
      }
    }
  )
)