Well.R

#' Well
#' @description Object representing a well, i.e. the screen experiment unit
#' @field dbConnection A dbConnection object
#' @field plate_ID Database ID of the plate the well belongs to
#' @field position Position of the well in the plate. Rows are referenced by letters
#' and columns by numbers starting with A1 in the top left corner.
#' @field label Label associated with the well
#' @field temperature temperature at which the well was kept
#' @field plate Plate object the well belongs to
#' @field samples List of Sample objects
#' @field compounds List of Compound objects
#' @field qc List of QC objects
#' @field datafiles List of Datafile objects representing plate-level data
#' @field phenotypes List of Phenotype objects
#' @field replicates Retrieves a list of Well objects from the same screen and having the  
#' same samples and compounds at the same dose. Can't be set.
#' 
#' @export
Well <- R6Class(
  classname = "Well",
  lock_class = TRUE,
  public = list(
    dbConnection = NULL,
    plate_ID = NULL,
    position = NULL,
    label = NULL,
    temperature = NULL,
    #' @description Create a Well object
    #' @param dbConnection A dbConnection object
    #' @param plate_ID Database ID of the plate the well belongs to
    #' @param position Position of the well in the plate. Rows are referenced by letters
    #' and columns by numbers starting with A1 in the top left corner.
    #' @param label Label associated with the well
    #' @param temperature temperature at which the well was kept
    initialize = function(dbConnection = NA, plate_ID = NA, position = NA,
                          label = NA, temperature = NA) {
      if(!("DBConnection" %in% class(dbConnection))) {
        stop("DB connection object required to create Well object")
      }
      if(is.na(plate_ID) || is.na(position)) { stop("Plate ID and well position required to create Well object") }
      if(is.na(label)) { warning("Consider giving a label to new Well object") }
      self$dbConnection <- dbConnection
      if("Plate" %in% class(plate_ID)) {
        plate_ID <- plate_ID$ID
      }
      self$plate_ID <- plate_ID
      self$position <- position
      self$label <- label
      self$temperature <- temperature
    },
    #' @description Output summary of the object content
    print = function() {
      cat(paste0(paste0("Plate ID: ", self$plate_ID), "\n",
                 paste0("Well position: ", self$position), "\n",
                 paste0("Label: ", self$label), "\n",
                 paste0("Samples: ", length(self$samples)), "\n",
                 paste0("Compounds: ", length(self$compounds)), "\n",
                 paste0("Temperature: ", self$temperature), "\n",
                 paste0("Quality control: ", length(self$qc)), "\n",
                 paste0("Phenotypes: ", length(self$phenotypes)), "\n",
                 paste0("Data files: ", length(self$datafiles)), "\n"))
    },
    #' @description Store the object into the database
    store = function() {
      wh <- WellHandle$new(self$dbConnection)
      status <- wh$store(list(self))
    }
  ),
  private = list(
    parent_plate = NULL,
    replicate_list = NULL,
    sample_list = NULL,
    compound_list = NULL,
    qc_list = NULL,
    datafile_list = NULL,
    phenotype_list = NULL
  ),
  active = list(
    plate = function(p) {
      if(missing(p)) {
        if(length(private$parent_plate) == 0) {
          ph <- PlateHandle$new(self$dbConnection)
          private$parent_plate <- ph$get_by_id(self$plate_ID)
        }
        return(private$parent_plate)
      } else {
        if(!("Plate" %in% class(p))) {
          stop("Well plate must be a Plate object.")
        }
        private$parent_plate <- p
      }
    },
    samples = function(s) {
      if(missing(s)) {
        if(length(private$sample_list) == 0) {
          sh <- SampleHandle$new(self$dbConnection)
          private$sample_list <- sh$get_all_by_well(self)
        }
        return(private$sample_list)
      } else {
        for(item in s) {
          if(!("Sample" %in% class(item))) {
            stop("Well samples must be Sample objects.")
          }
        }
        private$sample_list <- s
      }
    },
    compounds = function(c) {
      if(missing(c)) {
        if(length(private$compound_list) == 0) {
          ch <- CompoundHandle$new(self$dbConnection)
          private$compound_list <- ch$get_all_by_well(self)
        }
        return(private$compound_list)
      } else {
        for(item in c) {
          if(!("Compound" %in% class(item))) {
            stop("Well compounds must be Compound objects.")
          }
        }
        private$compound_list <- c
      }
    },
    qc = function(qctrl) {
      qh <- QCHandle$new(self$dbConnection)
      if(missing(qctrl)) {
        if(length(private$qc_list) == 0) {
          private$qc_list <- qh$get_all_by_well(self)
        }
        return(private$qc_list)
      } else {
        for(item in qctrl) {
          if(!("QC" %in% class(item))) {
            stop("Well qc must be QC objects.")
          }
        }
        private$qc_list <- qctrl
      }
    },
    datafiles = function(d) {
      if(missing(d)) {
        if(length(private$datafile_list) == 0) {
          dh <- DatafileHandle$new(self$dbConnection)
          private$datafile_list <- dh$get_all_by_well(self)
        }
        return(private$datafile_list)
      } else {
        for(item in d) {
          if(!("Datafile" %in% class(item))) {
            stop("Well datafiles must be Datafile objects.")
          }
        }
        private$datafile_list <- d
      }
    },
    phenotypes = function(p) {
      if(missing(p)) {
        if(length(private$phenotype_list) == 0) {
          ph <- PhenotypeHandle$new(self$dbConnection)
          private$phenotype_list <- ph$get_all_by_well(self)
        }
        return(private$phenotype_list)
      } else {
        for(item in p) {
          if(!("Phenotype" %in% class(item))) {
            stop("Well phenotypes must be Phenotype objects.")
          }
        }
        private$phenotype_list <- p
      }
    },
    replicates = function() {
      wh <- WellHandle$new(self$dbConnection)
      private$replicate_list <- wh$get_replicates(self)
      return(private$replicate_list)
    }
  )
)