PhenotypeHandle.R

#' PhenotypeHandle
#' @description Object for handling database operations related to the storage and 
#' retrieval of Phenotype objects.
#' @field dbConnection A dbConnection object
#' @export
PhenotypeHandle <- R6Class(
  classname = "PhenotypeHandle",
  lock_class = TRUE,
  public = list(
    dbConnection = NULL,
    #' @description Create an object for handling database operations related to 
    #' the storage and retrieval of Phenotype objects.
    #' @param dbConnection A dbConnection object
    initialize = function(dbConnection = NA) {
      self$dbConnection <- dbConnection
    },
    #' @description Retrieve a Phenotype object using its database ID
    #' @param dbID Database ID of the Phenotype object to retrieve
    #' @return A Phenotype object
    get_by_id = function(dbID) {
      query <- "SELECT * FROM Phenotype WHERE ID = ?"
      df <- self$dbConnection$get_data(query, list(dbID))
      if(length(df$ID)>0) {
        phenotype <- Phenotype$new(dbConnection = self$dbConnection,
                                   ID = df$ID,
                                   xrefID = df$xrefID, 
                                   xrefDB = df$xrefDB,
                                   name = df$name,
                                   description = df$description)
        return(phenotype)
      } else { return(NULL) }
    },
    #' @description Retrieve all phenotypes associated with a well
    #' @param well A Well object
    #' @return List of Phenotype objects
    get_all_by_well = function(well) {
      query <- "SELECT P.*, WhP.value, WhP.unit FROM Phenotype AS P, Well_has_Phenotype AS WhP
                WHERE WhP.Plate_ID = ? AND WhP.Well_position = ? AND
                      WhP.Phenotype_ID = P.ID"
      data <- self$dbConnection$get_data(query, list(well$plate_ID, well$position))
      if(length(data$ID)>0) {
        phenotypes <- list()
        df.list <- split(data, data$ID)
        for(df in df.list) {
          ph <- Phenotype$new(dbConnection = self$dbConnection,
                              ID = df$ID,
                              xrefID = df$xrefID, 
                              xrefDB = df$xrefDB,
                              name = df$name,
                              description = df$description,
                              value = df$value,
                              unit = df$unit)
          phenotypes <- c(phenotypes, ph)
        }
        return(phenotypes)
      } else { return(NULL) }
    },
    #' @description Generate a database ID for a Phenotype object
    #' @param xrefDB (optional) External database where the phenotype is referenced
    #' @param xrefID (optional) ID in the database given by xrefDB, used to check 
    #' if the compound is already in the database
    #' @return A string starting with the prefix PHE:
    get_new_ID = function(xrefDB = NULL, xrefID = NULL) {
      ID <- NULL
      if(length(xrefDB) > 0 && !is.na(xrefDB) &&
          length(xrefID) > 0 && !is.na(xrefID)) {
        # Check if it is already in the database
        query <- "SELECT ID FROM Phenotype
                  WHERE xrefDB = ? AND xrefID = ?"
        df <- self$dbConnection$get_data(query, list(xrefDB, xrefID))
        if(nrow(df) == 1) {
          ID <- df$ID
        } else if(nrow(df) > 1) {
          stop(paste0("Multiple phenotypes match the provided ID: ",
                      xrefID, " from reference DB ", xrefDB))
        }
      }
      if(length(ID) == 0 || is.na(ID)) {
        query <- "SELECT seq FROM Phenotype ORDER BY seq DESC LIMIT 1"
        df <- self$dbConnection$get_data(query)
        if(nrow(df)>0) {
          ID <- paste0("PHE:", sprintf("%012d", df$seq+1))
        } else { # The table is empty
          ID <- paste0("PHE:", sprintf("%012d",1))
        }
      }
      return(ID)
    },
    #' @description Store Phenotype objects in the database
    #' @param phenotype.list A list of Phenotype objects
    store = function(phenotype.list) {
      statement <- "INSERT IGNORE INTO Phenotype (ID, xrefID, xrefDB, name, description)
                                VALUES (?, ?, ?, ?, ?)" 
      for(phenotype in phenotype.list) {
        result <- self$dbConnection$execute(statement, list(phenotype$ID,
                                                            phenotype$xrefID,
                                                            phenotype$xrefDB,
                                                            phenotype$name,
                                                            phenotype$description))
        if(length(phenotype$terms)>0) {
          th <- TermHandle$new(self$dbConnection)
          result <- th$store(phenotype$terms)
          for(term in phenotype$terms) {
            st <- "INSERT IGNORE INTO Phenotype_has_Term (Phenotype_ID, Term_ID)
                        VALUES (?, ?)"
            r <- self$dbConnection$execute(st, list(phenotype$ID, term$ID))
          }
        }
      }
    }
  )
)