R/MicroPlate.R

# this is the main file for interacting with MicroPlate object
# they are created by parsers
# 
# Data stores everything!
# hopefully on different levels...
# 
# TODO:
# - createFromDataFrame
# - dim, length, +-*/ == !=
# - consider: Arith() = +-*/  ???
# - consider: Compate = == != < > etc... ???
# - consider: nrow, colnames, head, names etc
# - stringsAsFactors,  check.names... if i want to inherent data.frame -- make.names...
#     also factors may safe memory!!! ... but it may make everything even more slow...
# http://stackoverflow.com/questions/8691812/get-object-methods-r
# may also need the assignment variables like "$<-"... but i don't know if i want to give users that much access.
# 
# TODO allow plate deletion!
#
# ok... maybe make the data lockable???
# 
# more TODO:
# tab integration... MicroPlate$ should display the list of colnames in rstudio if possible...
#
# overwritting/defining +/-*operators
# https://stat.ethz.ch/pipermail/r-help/2011-March/273554.html
# http://stackoverflow.com/questions/4730551/making-a-string-concatenation-operator-in-r -- nice example
# http://stackoverflow.com/questions/14035506/how-to-see-the-source-code-of-r-internal-or-primitive-function -- needed for variable names!!!
#
# memory managment:
# http://adv-r.had.co.nz/memory.html
#
# maybe useful:
# http://web.njit.edu/all_topics/Prog_Lang_Docs/html/library/methods/html/GenericFunctions.html
# 
# data.frame source:
# https://github.com/SurajGupta/r-source/blob/91aaa43312da6b0e6906ef221fd7756dc0459843/src/library/base/R/dataframe.R
#
#
#
#
# adding contains data.frame changes:
# > testData
# An object of class "MicroPlate"
# Slot ".data":
#   <environment: 0x5f248f0>
# to:
# > testData
# Object of class "MicroPlate"
# data frame with 0 columns and 0 rows
# Slot ".data":
#   <environment: 0x537d728>
#
#


#
#' MicroPlate
#' 
#' This class stores MicroPlate data
#' 
#' for memory reasons everything is to be stored in an enviroment .data
#' all behaviour to acces the .data is overwritten to work with it...
#' this means that once you have created an instance of a class you can copy it 
#' and the data is still stored at only 1 location
#'  
#' 
#' 
#' @export
#' @include generalFunctions.R setup.R
#' @import methods gtools plyr 
MicroPlate=setClass(
  Class = "MicroPlate", 
#   contains = "data.frame", # S3 S4 conflicts??? it kinda doesnt work :P
  representation = representation(
#     x="list", # data.frame has this???
    .data="environment" # only i may touch me!
  )
#   ,
#   prototype = prototype(
#     .data=new.env() # make sure it has its own little space
#   )
)
#' initialize
setMethod("initialize", "MicroPlate", function(.Object){
  ## initialize the love!
  # the core objects that store all the user data
  .Object@.data=new.env() # make sure it has its own little space
  .Object@.data$measurement=NULL # stores all measurement data!
  .Object@.data$well=NULL # stores all well data!
  .Object@.data$plate=NULL # stores all plate data!
  
  # the rest is meta data stored in a way for fast access
  # and is used by the rest of the program for checks and data access
  # the consistency of these values is enforced by the function updateMetaData
  # which should be called after each change
  #
  ## per column
  .Object@.data$colNames=NULL # stores the colnames!
  .Object@.data$colLevel=NULL # contains the name of the level
  .Object@.data$colLevelNr=NULL # contains the level number
  ## per level
  .Object@.data$level=NULL # contains the name of the level which corresponds to a column name of the level above
  .Object@.data$levelNr=NULL # contains the level 1 = measurement, 2 = well etc...
  .Object@.data$levelSize=NULL # number of rows per level
  ## per plate
  .Object@.data$measurementsPerPlate=NULL # contains the number of measurements per plate
  .Object@.data$wellsPerPlate=NULL # contains the number of wells per plate 
  #
  #
  #
  # need to get a way to get to the right level.... and back???
  # rownames are ignored...
  .Object@.data$reservedNames=c("plate","measurement") # well was in here... but its a lot less important now anyways...
  
  return(.Object)
})


#' merge
#' @rdname merge
#' @details
#' merge two MicroPlates
#' 
#' default it removes the 2nd (other)
#' 
#' @param self the MicroPlate object
#' @param other the other MicroPlate object
#' @param removeOther default behaviour is to remove the other/2nd MicroPlate given, put FALSE to stop this.
#' 
#' todo: make it possible to merge to plates which have the same column name at different levels. (make them all the lowest level)
#' 
#' 
#' @export
setGeneric("merge", function(self,other,removeOther=TRUE) standardGeneric("merge"))
#' @rdname merge
setMethod("merge", signature(self = "MicroPlate", other="MicroPlate"), function(self,other,removeOther=TRUE){
  # 
#   self@.data$colNames
#   other@.data$colNames
  
  # new means that other has them and self does not
  # missing means that other does not have them but self does
  nrOfPlates=self@.data$levelSize[3]
  nrOfWells=self@.data$levelSize[2]
  nrOfMeasurements=self@.data$levelSize[1]
  nrOfNewPlates=other@.data$levelSize[3]
  nrOfNewWells=other@.data$levelSize[2]
  nrOfNewMeasurements=other@.data$levelSize[1]
#   plateNumber=self@.data$levelSize[self@.data$level=="plate"]+1 #this needs change
  
  colsPlate=names(other@.data$plate)
  colsWell=names(other@.data$well)
  colsMeasurement=names(other@.data$measurement)
  newColsPlate=colsPlate[!(colsPlate %in% self@.data$colNames[self@.data$colLevel=="plate"])]
  newColsWell=colsWell[!(colsWell %in% self@.data$colNames[self@.data$colLevel=="well"])]
  newColsMeasurement=colsMeasurement[!(colsMeasurement %in% self@.data$colNames[self@.data$colLevel=="measurement"])]
  missingColsPlate=self@.data$colNames[self@.data$colLevel=="plate"][!(self@.data$colNames[self@.data$colLevel=="plate"] %in% colsPlate)]
  missingColsWell=self@.data$colNames[self@.data$colLevel=="well"][!(self@.data$colNames[self@.data$colLevel=="well"] %in% colsWell)]
  missingColsMeasurement=self@.data$colNames[self@.data$colLevel=="measurement"][!(self@.data$colNames[self@.data$colLevel=="measurement"] %in% colsMeasurement)]
  existingColsPlate=colsPlate[(colsPlate %in% self@.data$colNames[self@.data$colLevel=="plate"])]
  existingColsWell=colsWell[(colsWell %in% self@.data$colNames[self@.data$colLevel=="well"])]
  existingColsMeasurement=colsMeasurement[(colsMeasurement %in% self@.data$colNames[self@.data$colLevel=="measurement"])]


  # plate
  if(length(newColsPlate)>0){
    for(i in 1:length(newColsPlate)){
      # create new column
      # fill existing plate columns with NA and add the new data
      self@.data$plate[[newColsPlate[i]]]=append(rep(x=NA,nrOfPlates),other@.data$plate[[newColsPlate[i]]])
    }
  }
  if(length(missingColsPlate)>0){
    for(i in 1:length(missingColsPlate)){
      # fill the existing columns for which the newData has no data with NA
      self@.data$plate[[missingColsPlate[i]]]=append(self@.data$plate[[missingColsPlate[i]]],rep(x=NA,nrOfPlates))
    }
  }
  if(length(existingColsPlate)>0){ # this should always be the case as row and column are mandatory...
    for(i in 1:length(existingColsPlate)){
      # add newData to existing columns
      self@.data$plate[[existingColsPlate[i]]]=append(self@.data$plate[[existingColsPlate[i]]],other@.data$plate[[existingColsPlate[i]]])
    }
  }


  # Well
  for(i in 1:length(newColsWell)){ # measurement is seen as a new column
    # create new column
    # fill the existing wells with NA and add the new data
    
    # note that: newColsWell contains measurement!
    if(newColsWell[i]=="measurement"){
      # starting positions of other are increased by nrOfMeasurements of self
      self@.data$well$measurement=append(self@.data$well$measurement,(other@.data$well$measurement+self@.data$levelSize[1]))
    } else if(newColsWell[i]=="plate"){
      # plate number reference
      # plate numbers need to match row numbers, so you cannot use the row numbers from other.
      # the row numbers need to continue from the last self plate row number
      for(i in 1:nrOfNewPlates){
        # get number of wells per plate
        #     nrOfWellsPerPlate=sum(other@.data$data$plate==i) 
        self@.data$well$plate=append(self@.data$well$plate, rep(x=nrOfPlates+i,other@.data$wellsPerPlate[[i]]))
      }
    } else {
      self@.data$well[[newColsWell[i]]]=append(rep(x=NA,nrOfWells),other@.data$well[[newColsWell[i]]])
    }
  }
#   print(paste("missingColsWell",missingColsWell))
  if(length(missingColsWell)>0){
    for(i in 1:length(missingColsWell)){
      # fill the existing columns for which the newData has no data with NA
      self@.data$well[[missingColsWell[i]]]=append(self@.data$well[[missingColsWell[i]]],rep(x=NA,nrOfNewWells))
    }
  }
#   print(paste("existingColsWell",existingColsWell))
  if(length(existingColsWell)>0){ # this should always be the case as row and column are mandatory...
    for(i in 1:length(existingColsWell)){
      # add newData to existing columns
      self@.data$well[[existingColsWell[i]]]=append(self@.data$well[[existingColsWell[i]]],other@.data$well[[existingColsWell[i]]])
    }
  }

  # measurement
  if(length(newColsMeasurement)>0){
    for(i in 1:length(newColsMeasurement)){
      # create new column
      # fill existing columns with NA and add the new data
      self@.data$measurement[[newColsMeasurement[i]]]=append(rep(x=NA,nrOfMeasurements),other@.data$measurement[[newColsMeasurement[i]]])
    }
  }
  if(length(missingColsMeasurement)>0){
    for(i in 1:length(missingColsMeasurement)){
      # fill the existing columns for which the newData has no data with NA
      self@.data$measurement[[missingColsMeasurement[i]]]=append(self@.data$measurement[[missingColsMeasurement[i]]],rep(x=NA,nrOfNewMeasurements))
    }
  }
  if(length(existingColsMeasurement)>0){
    for(i in 1:length(existingColsMeasurement)){
      # add newData to existing columns
      self@.data$measurement[[existingColsMeasurement[i]]]=append(self@.data$measurement[[existingColsMeasurement[i]]],other@.data$measurement[[existingColsMeasurement[i]]])
    }
  }
  
  
  # remove other
  if(removeOther){
    rm(list=deparse(substitute(other)),envir=sys.frame(-2))
  }
  
  updateMetaData(self)
  
  return(self)
})


#' updateMetaData
#' @rdname updateMetaData
#' @keywords internal 
#' @description
#' this method is responsible for updating colnames and meta data
#' to keep the Data from working properly
#' 
#' TODO make it so that the level meta data is sorted! --DONE!!!
#' this allowes the rest of the code to be optimized a bit more...
#' self@@.data$levelSize[self@@.data$level=="plate"] would become self@@.data$levelSize[3] -- not done yet!
#' measurement=1, well=2, plate=3
#' 
#' 
#' @param self the MicroPlate object
#' 
#' 
#' @export
#' @import plyr
setGeneric("updateMetaData", function(self) standardGeneric("updateMetaData"))
#' @rdname updateMetaData
setMethod("updateMetaData", signature(self = "MicroPlate"), function(self){
  # measurement
  self@.data$level="measurement"
  self@.data$levelNr=1 # measurement=1, well=2, plate=3
  self@.data$levelSize=length(self@.data$measurement[[1]])
  self@.data$colNames=names(self@.data$measurement)
  self@.data$colLevel=rep("measurement",length(self@.data$measurement))
  self@.data$colLevelNr=rep(1,length(self@.data$measurement))
  #
  # well
  self@.data$level=append(self@.data$level,"well")
  self@.data$levelNr=append(self@.data$levelNr,2)
  self@.data$levelSize=append(self@.data$levelSize,length(self@.data$well[[1]]))
  self@.data$well$well=1:self@.data$levelSize[2]# add/update well column
  self@.data$colNames=append(self@.data$colNames,names(self@.data$well)[!is.element(names(self@.data$well),c("measurement","plate"))])  
  self@.data$colLevel=append(self@.data$colLevel,rep("well",length(self@.data$well)-2)) # ignore col plate and measurement
  self@.data$colLevelNr=append(self@.data$colLevelNr,rep(2,length(self@.data$well)-2))
  #
  # plate
  self@.data$level=append(self@.data$level,"plate")
  self@.data$levelNr=append(self@.data$levelNr,3) # measurement=1, well=2, plate=3
  self@.data$levelSize=append(self@.data$levelSize,length(self@.data$plate[[1]]))
  self@.data$colNames=append(self@.data$colNames,names(self@.data$plate))
  self@.data$colLevel=append(self@.data$colLevel,rep("plate",length(self@.data$plate)))
  self@.data$colLevelNr=append(self@.data$colLevelNr,rep(3,length(self@.data$plate)))
  # wellsPerPlate
  self@.data$wellsPerPlate=plyr::count(self@.data$well$plate)[[2]]
  
  # measurementsPerWell
  self@.data$measurementsPerWell= ( c(self@.data$well$measurement[-1],(self@.data$levelSize[1]+1)) - self@.data$well$measurement )
  
  
  # measurementsPerPlate
  currentWellNr=1
  nextWellNr=1
  self@.data$measurementsPerPlate=NULL
  self@.data$firstMeasurmentRowNrPerPlate=NULL
  firstMeasurmentRowNrPerPlate=1
  for(i in 1:length(self@.data$plate[[1]])){# for each plate
    currentWellNr=nextWellNr
    nextWellNr=currentWellNr+self@.data$wellsPerPlate[i]# nrOfWells
    nrOfMeasurement=0
    if(!is.na(self@.data$well$measurement[nextWellNr])){
      nrOfMeasurement=self@.data$well$measurement[nextWellNr]-self@.data$well$measurement[currentWellNr]
    }else{
      # last well
      nrOfMeasurement=length(self@.data$measurement[[1]])-self@.data$well$measurement[currentWellNr]+1
    }
    
    self@.data$measurementsPerPlate=append(self@.data$measurementsPerPlate,nrOfMeasurement)
    self@.data$firstMeasurmentRowNrPerPlate=append(self@.data$firstMeasurmentRowNrPerPlate,firstMeasurmentRowNrPerPlate)
    firstMeasurmentRowNrPerPlate=firstMeasurmentRowNrPerPlate+nrOfMeasurement
  }
})


#' []
#' overwrite the [] function..
#'
#' 
#' @description
#' Returns data as if it was a data.frame (so in many cases it returns a data.frame)
#' Unlike a date.frame this function wont repeat cols and rows, if the same row/col is requested multiple times
#' 
#' this function gives the data at the appropiate level "plate","well" or "measurement"
#' collumns of a higher level will be repeated
#' 
#' @note
#' data.frame also has a DUMP slot... no clue what this does... or how to call it...
#' its probably not called... but instead filled when called... don't know its function though...
#' 
#' 
#' @param x MicroPlate
#' @param i row - number only
#' @param j column - use column number or column name
#' @param ... you can use the argument "level" to force the data to be repeated for the appropiate level: "plate","well","measurement"  other uses of ... will throw errors.
#' 
#' TODO: merge modes more AKA recode
#' TODO: document all params... though they are hard to read ...
#' TODO: consider formula mode
#' TODO: consider adding a single measurement point to well level if specifically requested...
#' 
#' 
#' @export 
setMethod("[", signature(x = "MicroPlate", i = "ANY", j = "ANY"), function(x, i , j, ...) {
  args <- list(...)
  argsNames=names(args)
  col=NULL
  row=NULL
  
#     print("nr of parameters..")
#     print(nargs())
#     print(length(args))
#     print(nargs()-length(args))
  #
  # data.frame has some special behaviour
  if(missing(i) & missing(j)){
    # mp[]<- and mp[,]<-
    # print("mp[] or mp[,]")
    # return everything
    row=NULL
    col=NULL
  } else if(missing(i)){
    # mp[,1]<-
    #     print("mp[,1]")
    row=NULL
    col=j
  } else if(missing(j) & (nargs()-length(args))==2  )  {
    # mp[1]<-
    # print("mp[1]")
    # the 2 are: the MicroPlate,the column
    # data.frame special case
    # should return column instead of row!
    row=NULL
    col=i
  } else if(missing(j)) {
    # mp[1,]<-
    # print("mp[1,]")
    row=i
    col=NULL
  } else {
    # mp[1,2]<-
    # print("mp[1,2]")
    row=i
    col=j
  }
  
  
  # if present convert level to number instead string
  if(!is.null(args$level)){
    # mp[...level=..]=value
    # check if args level is 1,2,3 or "plate","well","measurement"
    if(class(args$level)=="character"){
      # check if its a valid level name
      if(any(is.element(x@.data$level,args$level))) {
        args$level=x@.data$levelNr[x@.data$level==args$level]
      }else {
        stop(paste("level given not in: ",paste(x@.data$level,collapse=" ")," given level: ",level,sep=""))
      }
    } else if(class(args$level)=="numeric"| class(args$level)=="integer"){
      if(!any(is.element(x@.data$levelNr,args$level))){
        stop(paste("level given not in: ",paste(x@.data$levelNr,collapse=" ")," given level: ",args$level,sep=""))
        #         stop(paste("level is of invalid class expected level name: ",paste(x@.data$level, collapse=" "),"\n or level number: ",paste(x@.data$levelNr,collapse=" "),"\n but got data of class: ",class(args$level),sep=""))
      }
    }
  }
  
  # 2nd check level
  level=NULL
  # get col to colnames if possible...
  if(!is.null(col)){
    # check col
    if(!(class(col)=="numeric" | class(col)=="integer" | class(col)=="character") ){
      stop(paste("col index should be a number or char, not a: ",class(col)))
    }
    if((class(col)=="numeric" | class(col)=="integer") & !all(is.element(col,1:length(x@.data$colNames)))  ) {
      stop(paste("column number(s) given that does not exist!\n number(s) given:",paste(col,collapse=", "),"\n max col number in data:",length(x@.data$colNames), sep=""))
    }
    if(length(col)!=length(unique(col))){
      stop("duplicate columns selected")
    }
    if (any(is.element(col,x@.data$reservedNames))){
      stop(paste("The following names are reserved for other purposes!: ",paste(x@.data$reservedNames,sep=", ",collapse  = " "), sep=""))
    }
    
    # also change to names if numbers
    if(class(col)!="character"){ 
      col=x@.data$colNames[col]
    }
    
    # check if all columns exist
    if(!all(col%in%x@.data$colNames)) stop(paste("columns given that do not exist:", paste(col, collapse=", "), "\n valid colnames are:",paste(x@.data$colNames,collapse=", "), sep=""))
    
    if(suppressWarnings(min(x@.data$colLevelNr[x@.data$colNames%in%col]))!=Inf){
      level=suppressWarnings(min(x@.data$colLevelNr[x@.data$colNames%in%col]))
      #       print(paste("min excisting level=",level))
    }
  } else { 
    # col==NULL
    # level determined by other factors
  }
  
  if(!is.null(args$level)){
    # mp[...level=..]=value
    # check if level matches...
    if(!is.null(level)){
      if(args$level>level) {
        stop("level parameter greater than column selection")
      }else{
        level=args$level
      }
    }else{
      level=args$level
    }
  }
  
  
  # check row and make it a logical
  if(!is.null(row)){
    # mp[row,...]
    if(!(class(row)=="numeric" | class(row)=="integer" | class(row)=="logical")){
      stop(paste("row index should be a number or a logical, not a: ",class(row)))
    }
    
    # todo: check length?
    # todo: check selction length?
    if(is.null(level)){
      # stop("can this happen??????????????") # it can!
      # mp[row,]
      if(is.null(col)){
        # mp[row,]
        if(class(row)=="logical"){
          # check if it matches a specific level
          if(length(row)%in%x@.data$levelSize){
            level=min(x@.data$levelNr[x@.data$levelSize%in%length(row)])
          } else {
            stop(paste("boolean row selection did not match number of rows in any of the levels ",paste(x@.data$levelSize,sep=", ")))
          }
        }else{
          # assume its measurement
          level=1
        }
      }else{
        stop("can this happen??????????????")
      }
    }
    
    if(!is.logical(row)){
      if(max(row)>x@.data$levelSize[level])stop("level and row numbers do not match")
      row=(1:x@.data$levelSize[level])%in%row
    }else{
      if(length(row)>x@.data$levelSize[level])stop("level and row numbers do not match")
    }
    # row should be logical now
  } else {
    # rows were not provided
    # mp[,col,...]=value
    # mp[] mp[,]
    if(is.null(level)){ # level was not yet set
      #df[]???
      level=1
    }
    #     print(level)
    row=rep(T,x@.data$levelSize[level])
  }



  # check args for 
  if(!length(args)==0){
    # check if names
    if(any(argsNames%in%"")) stop("unspecified argument provided")
    if(length(argsNames)!=length(unique(argsNames))) stop("you are only allowed to use arguments once")
    if(!all(argsNames%in%append(x@.data$colNames,c("well","plate","level")))) stop(paste("only allowed: ",paste(x@.data$colNames,sep=", ",collapse = ", "),", well and level",sep=""))
  
  
  }
  
  if(is.null(col)){# if col is still NULL set it to everything at that level
    col=x@.data$colNames[x@.data$colLevelNr>=level]
  }
  
#   print(level)
#   print(row)
#   print(col)
  bothCol=union(x@.data$colNames[x@.data$colNames%in%argsNames],col)
#   print(bothCol)
  
  returnValue=NULL
  
  
  # return the requested data.
  if(level==3){ # plate
    returnValue=as.data.frame(as.data.frame(x@.data$plate, stringsAsFactors=F)[,bothCol],stringsAsFactors=F)
    colnames(returnValue)=bothCol
  }else if (level==2){ # well
    # repeat plate for each well
    #
    # reserve space
    returnValue=data.frame(matrix(nrow=x@.data$levelSize[level],ncol=length(bothCol)), stringsAsFactors=F)
    colnames(returnValue)=bothCol
    for(colnr in 1:length(bothCol)){ # for each column
      if(x@.data$colLevel[x@.data$colNames==bothCol[colnr]]=="plate"){
        start=1
        end=0
        for(i in 1:length(x@.data$plate[[1]])){ # for each plate
          # repeat the plate information for each well
          end=end+x@.data$wellsPerPlate[i]
          returnValue[start:end,colnr]=x@.data$plate[[bothCol[colnr]]]
          start=end+1
        }
      }else if(x@.data$colLevel[x@.data$colNames==bothCol[colnr]]=="well"){
        returnValue[colnr]=x@.data$well[[bothCol[colnr]]]
      }else{
        stop("WEIRD ERROR !@#!")
      }
    }
  }else if(level==1){ # measurement
    #
    # fetch the requested data
    
    wellToMeasurement=rep(1:x@.data$levelSize[2],x@.data$measurementsPerWell)
    
    returnValue=data.frame(matrix(nrow=x@.data$levelSize[level],ncol=length(bothCol)),stringsAsFactors = FALSE)
    colnames(returnValue)=bothCol
    for(colnr in 1:length(bothCol)){ # for each column
      # always first fill tempdata with the whole column (at measurement level)
      # then do the row select
      if(x@.data$colLevel[x@.data$colNames==bothCol[colnr]]=="measurement"){
        # get whole column
        returnValue[colnr]=x@.data$measurement[[bothCol[colnr]]]
      } else if(x@.data$colLevel[x@.data$colNames==bothCol[colnr]]=="well"){
        # data at top level
        #
        returnValue[colnr]=x@.data$well[[bothCol[colnr]]][wellToMeasurement]
      } else if(x@.data$colLevel[x@.data$colNames==bothCol[colnr]]=="plate"){
        # repeat for eachWell*eachMeasurement
        end=0
        for(i in 1:x@.data$levelSize[3]){ # for each plate
          # get the corresponding plate values
          start=x@.data$firstMeasurmentRowNrPerPlate[i]
          end=end+x@.data$measurementsPerPlate[i]
          returnValue[start:end,colnr]=x@.data$plate[[bothCol[colnr]]][[i]]
        }
      } else {
        stop("data at unknown level... this error means a coding error as it should have been cought above!")
      }
    }
  }
  
  
  
  # check selection
  selection=NULL# make sure it is available on the right level only..
  if(!length(args)==0){ # 2nd part is to prevent an endless loop
    # mp[... something=something]=value
        
#     mp=x[level=level] # make sure this part is never called from itself
    size=x@.data$levelSize[level]
    true=rep(T,size)
    false=logical(size)
    selection=true
    
    for(i in 1:length(args)){
      if(argsNames[i]=="level"){
        # already handled above
      }else if(argsNames[i]=="well"){
        #           print(class(args[[i]]))
        #           print(args[[i]])
        if(class(args[[i]])=="character"){ # A11
          coordinates=extractPlateCoordinates(args[[i]]) # A11 ->  A=1 , 11=11 ....
          selection=selection&(returnValue$row%in%coordinates["row"])
          selection=selection&(returnValue$col%in%coordinates["column"])
        } else if((class(args[[i]])=="numeric")||(class(args[[i]])=="integer")){ # well numbers
          if(level==1){ # measurement level
            # todo for is very slow! so change this later!
            wellNrs=double(size)
            for(j in 1:x@.data$levelSize[2]){# for each well
              wellNrs[getWellsMeasurementIndex(x,j)]=j
            }
            selection=selection&(wellNrs%in%args[[i]])
          } else if(level==2){# well level
            selection=selection&((1:size)%in%args[[i]])
          }else stop("can't use well selection at plate level")
        } else stop("weird well selection")
      }else if(argsNames[i]=="plate"){
        if(level==1){# measurement level
          plateNrs=double(size)
          for(j in 1:x@.data$levelSize[3]){# for each plate
            plateNrs[getPlatesMeasurementIndex(returnValue,j)]=j
          }
          selection=selection&(plateNrs%in%args[[i]])
        }else if (level==2){# well level
          plateNrs=double(size)
          for(j in 1:x@.data$levelSize[3]){# for each plate
            plateNrs[getPlatesWellIndex(mp,j)]=j
          }
          selection=selection&(plateNrs%in%args[[i]])
        }else {# plate level
          selection=selection&((1:size)%in%args[[i]])
        }
        
      }else{ # its a col name
        selection=selection&(returnValue[[argsNames[i]]]%in%args[[i]])
      }
      #         print(sum(selection))
    }# for each args/...
  }# if each args/...
  
  if(!is.null(selection)){
    selection=selection&row
  }else{
    selection=row
  }
  
#   print(paste("selection length: ",length(selection),"nrOfSelctions", sum(selection)))
#   print(paste("col:",col))
  return(returnValue[selection,col])
}) 
  
  
#' [[]]
#' overwrite the [[]] function..
#' @description
#' data.frame also has a DUMP slot... no clue what this does... or how to call it...
#' its probably not called... but instead filled when called... don't know its function though...
#' 
#' STILL VERY BUGGY!!!
#' 
#' @param x the MicroPlate object
#' @param i row selection
#' @param j column selection
#' @param ... you can use the argument "level" to force the data to be repeated for the appropiate level: "plate","well","measurement"  other uses of ... will throw errors.
#' 
#' @export 
setMethod("[[", signature(x = "MicroPlate", i = "ANY", j = "ANY"), function(x, i , j, ...) {
  args <- list(...)
  level=NULL
      
  # check for level in input
  if(!length(args)==0){
    if(length(args)==1 & !is.null(args$level)){
      level=args$level
    } else {
      stop("invalid args given, only accepts i,j,level")
    }
  }

  if(missing(i) & missing(j)){
    # df[] and df[,]
    stop("df[[]] or df[[,]] CRASH!")
  } else if(missing(i)){
    # df[,1]
    stop("df[,1] CRASH!")
  } else if( ( missing(j) & nargs()==2 ) | ( missing(j) & nargs()==3 & !is.null(level) ) ){
    # df[1], df[1,level=...]
    if(is.null(level)){
      temp=x[i]
    } else {
      temp=x[i,level=level]
    }
    return(temp[[dim(temp)[2]]])
  }else if(missing(j)) {
    # df[1,]
    stop("df[1,] CRASH!")
  } else {
    # df[1,2]
    if(is.null(level)){
      temp=x[i,j]
    }else{
      temp=x[i,j,level=level]
    }
    return(temp[[dim(temp)]])
  }
  stop("I should never get here. CRASH!")
})


#' removeColumn
#' @rdname removeColumn
#' @description
#' remove the column with the given colname
#' 
#' @param self the MicroPlate object
#' @param colNames the names of the columns you want to delete
#' 
#' @export
setGeneric("removeColumn", function(self, colNames) standardGeneric("removeColumn"))
#' @rdname removeColumn
setMethod("removeColumn", signature(self = "MicroPlate" ), function(self, colNames) {
  col=colNames
  
  # check col
  if(!(class(col)=="numeric" | class(col)=="integer" | class(col)=="character")){
    stop(paste("col index should be a number or char, not a: ",class(col)))
  }  
  
  # also change to names if numbers
  if(class(col)!="character"){
    # check if its a valid column number
    if(max(col)>length(self@.data$colNames)){
      stop(paste("MicroPlate only has ", length(self@.data$colNames) ," columns, asked for column ", max(col), sep="",collapse=""))
    }
    col=self@.data$colNames[col]
  }
  
  # check valid column names
  if(class(col)=="character" & length(wcol<-unique(col[!is.element(col,self@.data$colNames)]))>0 ) {
    stop(paste("columns given that do not exist:", paste(wcol, collapse=", "), "\n valid colnames are:",paste(self@.data$colNames,collapse=", "), sep=""))
  }
  
  # check for reserved names
  if (any(is.element(col,self@.data$reservedNames))){
    stop(paste("The following names are reserved for other purposes!: ",paste(self@.data$reservedNames,sep=", "), sep=""))
  }
  
  
  
  for(i in 1:length(col)) {
    # determine level
    level=self@.data$colLevel[self@.data$colNames==col[i]]
    
    if (level=="plate") {
      self@.data$plate[[col[i]]]=NULL
    } else if(level=="well") {
      self@.data$well[[col[i]]]=NULL
    } else if (level=="measurement") {
      self@.data$measurement[[col[i]]]=NULL
    }
  }
  # restore the balance
  updateMetaData(self)
  return(self)
})


#' [<-
#' overwrite the []<- function..
#' 
#' @description
#' NOTES:
#' only allows data of the same level to be added (so no adding well and measurement level data in one go)
#' this means no new rows can be created!!!! for now...
#' maybe an exception will be made if all variables of the row are given (need at least platenr/name)
#' 
#' differences with data.frame:
#' - data given has to be of the correct size!
#'   this function will not repeat your data!
#' - this function does allow you to create new rows!
#' - multiple collumns are only allowed if given a matrix or data.frame as input
#' - ignores all names in a data.frame
#' - it is possible to add a new column even if you do not give a value for all rows
#'   the remaining rows will be filled with NA
#' - new columns have to be named within the brackets!!
#'   all names in the value slot are ignored!   
#' - this function does not allow you to change the level of a colname
#'   if you want this done you would need to first delete that column using df[1]=NULL
#' - no negative indexing (matlab version is way better anyways)
#'  
#'  
#' todo: clean up code
#' todo mp[1]=NULL
#' todo also allow rows to be deleted?
#' 
#' todo: testData["content"]=1:12 -- content remains character instead of number/int
#' todo: list support? as in none string/number values
#' 
#' 
#' todo better row check... it is now pretty much assumed that user gives proper row numbers..
#' which is a silly thing to assume... use unique / max / min / interger
#' 
#' @param x the MicroPlate object
#' @param i row selection
#' @param j column selection
#' @param value the value to replace or add, with =NULL you can remove a column
#' @param ... you can use the argument "level" to force the data to be repeated for the appropiate level: "plate","well","measurement"  other uses of ... will throw errors.
#' 
#' @export 
setMethod("[<-", signature(x = "MicroPlate", i = "ANY", j = "ANY",value="ANY"), function(x, i, j, ..., value) {
  args <- list(...)
  col=NULL
  row=NULL
 
  dataRows=NULL
  dataCols=NULL
  
#   print("nr of parameters..")
#   print(nargs())
#   print(length(args))
#   print(nargs()-length(args))

  nrOfCol=length(x@.data$colNames)

  #
  # data.frame has some special behaviour
  if(missing(i) & missing(j)){
    # mp[]<- and mp[,]<-
    # print("mp[] or mp[,]")
    # return everything
    row=NULL
    col=NULL
  } else if(missing(i)){
    # mp[,1]<-
    #     print("mp[,1]")
    row=NULL
    col=j
  } else if(missing(j) & (nargs()-length(args))==3  )  {
    # mp[1]<-
    # print("mp[1]")
    # the 3 are: the MicroPlate,the column,the value
    # data.frame special case
    # should return column instead of row!
    row=NULL
    col=i
  } else if(missing(j)) {
    # mp[1,]<-
    # print("mp[1,]")
    row=i
    col=NULL
  } else {
    # mp[1,2]<-
    # print("mp[1,2]")
    row=i
    col=j
  }
    
  # first check if it is a remove operation
  if(is.null(value)){
    # check if its a column remove mp[names]=NULL
    # todo add checks to make sure only col is filled...
    if(!is.null(row)) stop("only allowed to delete columns, use: mp[1],mp['colname']")
    if(length(args)!=0) stop("only allowed to delete columns, use: mp[1],mp['colname']")
    return(removeColumn(x,col)) 
  }

  # if present convert level to number instead string
  if(!is.null(args$level)){
    # mp[...level=..]=value
    # check if args level is 1,2,3 or "plate","well","measurement"
    if(class(args$level)=="character"){
      # check if its a valid level name
      if(any(is.element(x@.data$level,args$level))) {
        args$level=x@.data$levelNr[x@.data$level==args$level]
      }else {
        stop(paste("level given not in: ",paste(x@.data$level,collapse=" ")," given level: ",level,sep=""))
      }
    } else if(class(args$level)=="numeric"| class(args$level)=="integer"){
      if(!any(is.element(x@.data$levelNr,args$level))){
        stop(paste("level given not in: ",paste(x@.data$levelNr,collapse=" ")," given level: ",args$level,sep=""))
        #         stop(paste("level is of invalid class expected level name: ",paste(x@.data$level, collapse=" "),"\n or level number: ",paste(x@.data$levelNr,collapse=" "),"\n but got data of class: ",class(args$level),sep=""))
      }
    }
  }

  # analyse new input
  # the way data.frame seems to handle data that 
  # does not match the size of the rows and columns selected
  # is by if its smaller then copy it ... but only if it can be devided without rest
  # if its more... ignore the more...
  # data is filled by column, so first all rows of a column are added, then the next column...
  # 
  # adding data.frames (and matrices??) need the right amount of rows and cols
  # what about lists???
  # if you use mp[] and you add something way bigger, 
  # it will keep the mp the same size, and throw a bunch of warning
  if(class(value)=="matrix"){
    value=data.frame(value, stringsAsFactors=F) # dont want to deal with this crap seperatly!
  }
  if(class(value)=="data.frame"){
    dataRows=dim(value)[1]
    dataCols=dim(value)[2]
  } else if (any(class(value) %in% c("character","numeric","integer","logical"))) {
    dataRows=length(value)[1]
    dataCols=1
  } else {
    stop(paste("data type of class: ",class(value)," not supported", sep="",collapse=""))
  }
  
  # 2nd check level
  level=NULL
  # get col to colnames if possible...
  if(!is.null(col)){
    # check col
    if(!(class(col)=="numeric" | class(col)=="integer" | class(col)=="character") ){
      stop(paste("col index should be a number or char, not a: ",class(col)))
    }
    if((class(col)=="numeric" | class(col)=="integer") & !all(is.element(col,1:nrOfCol))  ) {
      stop(paste("column number(s) given that does not exist!\n number(s) given:",paste(col,collapse=", "),"\n max col number in data:",nrOfCol, sep=""))
    }
    if(length(col)!=length(unique(col))){
      stop("duplicate columns selected")
    }
    if (any(is.element(col,x@.data$reservedNames))){
      stop(paste("The following names are reserved for other purposes!: ",paste(x@.data$reservedNames,sep=", ",collapse  = " "), sep=""))
    }

    # also change to names if numbers
    if(class(col)!="character"){ 
      col=x@.data$colNames[col]
    }
    
    # check if all levels are the same
    if(length(unique(x@.data$colLevelNr[x@.data$colNames%in%col]))>1) stop("you can change data only at 1 level at a time")
    # get the level
#     level=suppressWarnings(min(x@.data$colLevelNr[x@.data$colNames%in%col])) # not so much min, as any :P
    
    if(suppressWarnings(min(x@.data$colLevelNr[x@.data$colNames%in%col]))!=Inf){
      level=suppressWarnings(min(x@.data$colLevelNr[x@.data$colNames%in%col]))
#       print(paste("min excisting level=",level))
    }
    if(!is.null(level)){
      if(!is.null(args$level)){if(level!=args$level)stop("level parameter does not match column selection")}
    }
  } else { 
    # col==NULL
    # check if the data length matches a level
    if(max(x@.data$levelNr[x@.data$levelSize==dataRows])!=Inf){ # if data size=anyof the levels
      level=max(x@.data$levelNr[x@.data$levelSize==dataRows])
    }
  }


  if(!is.null(args$level)){
    # mp[...level=..]=value
    # check if level matches...
    if(!is.null(level)){
      if(args$level<level) {
        stop("level parameter does not match column selection")
      }else{
        level=args$level
      }
    }else{
      level=args$level
    }
  }

  # check selection
  selection=NULL# make sure it is available on the right level only..
  if(!length(args)==0){
    # mp[... something=something]=value
    names=names(args)
  
    # check if names
    if(any(names%in%"")) stop("unspecified argument provided")
    if(length(names)!=length(unique(names))) stop("you are only allowed to use arguments once")
    if(!all(names%in%append(x@.data$colNames,c("well","plate","level")))) stop(paste("only allowed: ",paste(x@.data$colNames,sep=", "),", well and level",sep=""))
    
    # check if data selection is not < then level
    if(!is.null(level)){
      if(sum(names%in%c("well","plate","level"))!=length(names)){
        if(min(x@.data$colLevel[x@.data$colNames%in%names])<level){
          stop("..........................................")
        }
      }else{
        # not sure.... yet...
      }
    } else {
      # can still determine on level size?
       stop("!!!!!!!!!!!!!!TODO!!!!!!!!!!!!1")
    }
    
   
    
    
    
    
    mp=x[level=level]
    size=x@.data$levelSize[level]
    true=rep(T,size)
    false=logical(size)
    selection=true
    
    for(i in 1:length(args)){
      if(names[i]=="level"){
        # already handled above
      }else if(names[i]=="well"){
        #           print(class(args[[i]]))
        #           print(args[[i]])
        if(class(args[[i]])=="character"){ # A11
          coordinates=extractPlateCoordinates(args[[i]]) # A11 ->  A=1 , 11=11 ....
          selection=selection&(mp$row%in%coordinates["row"])
          selection=selection&(mp$col%in%coordinates["column"])
        } else if((class(args[[i]])=="numeric")||(class(args[[i]])=="integer")){ # well numbers
          if(level==1){ # measurement level
            # todo for is very slow! so change this later!
            wellNrs=double(size)
            for(j in 1:x@.data$levelSize[2]){# for each well
              wellNrs[getWellsMeasurementIndex(mp,j)]=j
            }
            selection=selection&(wellNrs%in%args[[i]])
          } else if(level==2){# well level
            selection=selection&((1:size)%in%args[[i]])
          }else stop("can't use well selection at plate level")
        } else stop("weird well selection")
      }else if(names[i]=="plate"){
        if(level==1){# measurement level
          plateNrs=double(size)
          for(j in 1:x@.data$levelSize[3]){# for each plate
            plateNrs[getPlatesMeasurementIndex(mp,j)]=j
          }
          selection=selection&(plateNrs%in%args[[i]])
        }else if (level==2){# well level
          plateNrs=double(size)
          for(j in 1:x@.data$levelSize[3]){# for each plate
            plateNrs[getPlatesWellIndex(mp,j)]=j
          }
          selection=selection&(plateNrs%in%args[[i]])
        }else {# plate level
          selection=selection&((1:size)%in%args[[i]])
        }
        
      }else{ # its a col name
        selection=selection&(mp[[names[i]]]%in%args[[i]])
      }
      #         print(sum(selection))
    }# for each args/...
  }# if each args/...



  # check row and make it a logical
  if(!is.null(row)){
    if(!(class(row)=="numeric" | class(row)=="integer" | class(row)=="logical")){
      stop(paste("row index should be a number or a logical, not a: ",class(row)))
    }
    
#     if(is.logical(row)){
#       row=(1:length(row))[row] # convert it for now determine if it is valid later after level has been determined
#     }else{
#       if(length(row)!=length(unique(row))){
#         stop("duplicate rows selected")
#       }
#     }

    # todo: check length?
    # todo: check selction length?
    if(is.null(level))stop("can this happen??????????????")

    if(!is.logical(row)){
      if(max(row)>x@.data$levelSize[level])stop("level and row numbers do not match")
      row=(1:x@.data$levelSize[level])%in%row
    }else{
      if(length(row)>x@.data$levelSize[level])stop("level and row numbers do not match")
    }
    # row should be logical now
  } else {
    # rows were not provided
    # mp[,col,...]=value
    if(is.null(level)){ # level was not yet set
      if(dataRows%in%x@.data$levelSize){ # check data size
        level=max(x@.data$levelNr[x@.data$levelSize==dataRows])
      }else{ 
        stop("data not specified, and not the size of any of the levels...")
      }
    }
#     print(level)
    row=rep(T,x@.data$levelSize[level])
  }

  if(!is.null(selection)){
    selection=selection&row
  }else{
    selection=row
  }

  # check if row matches data, and data repeat
  if(sum(selection)!=dataRows){
    if(dataRows==1){
      # single value repeat is allowed!
      value=rep(value,sum(selection))
      dataRows=sum(selection)
    }else if(sum(selection)==1&&dataRows==length(col)){
      # rows and column switch!
      value=data.frame(matrix(value,1,dataRows),stringsAsFactors = F)# make columns columns instead of rows...
      dataCols=dataRows
      dataRows=1
    }else{
      print(paste("datarows=",dataRows," datacols=",dataCols," selection cols=",length(col)," selection rows=",sum(selection),sep=""))
      stop(paste("data length: ",dataRows," does not match selection length: ",sum(selection),sep=""))
    }
  }
  if(length(col)!=dataCols)stop(paste("nr of columns: ",dataCols," does not match selection length: ",length(col),sep=""))
  
  # change data
#   print("change data")
#   print(sum(selection))
#   print(col)
#   print(level)
  for(colnr in 1:length(col)){ # for each column
    # check if new column
    newColumn=!is.element(col[colnr],x@.data$colNames)
#     print(paste("newColumn: ",newColumn))
    #     print(row)
    #     print(col)
    #     print(level)
    
    if (level==3){ # plate 
      if(class(value)=="data.frame"){
        #         x@.data$plate[[col[colnr]]][row]=value[[col[colnr]]] 
        x@.data$plate[[col[colnr]]][selection]=value[[colnr]]
      }else{
        x@.data$plate[[col]][selection]=value
      }
      if(newColumn){
        x@.data$plate[[col[colnr]]][!selection]=NA #this is repeated if needed
      }
    } else if (level==2){ # well
      if(class(value)=="data.frame"){
        x@.data$well[[col[colnr]]][selection]=value[[colnr]]
      }else{
        x@.data$well[[col]][selection]=value
      }
      if(newColumn){
        x@.data$well[[col[colnr]]][!selection]=NA #this is repeated if needed
      }
    } else if(level==1){ # measurement
      
      if(class(value)=="data.frame"){
        x@.data$measurement[[col[colnr]]][selection]=value[[colnr]]
      }else{
        x@.data$measurement[[col]][selection]=value
      }
      if(newColumn){
        x@.data$measurement[[col[colnr]]][!selection]=NA #this is repeated if needed
      }
    } else {
      stop("data at unknown level... this error means a coding error as it should have been cought above!")
    }
    #     
    #     if(is.null(row)){
    #       # whole column
    #       returnValue[,colnr]=tempData
    #     } else {
    #       # specific rows
    #       returnValue[,colnr]=tempData[row]
    #     }
    #     
    #     
    
  }
  
  updateMetaData(x) # TODO maybe only if new cols?
  return(x) # without this... the whole thing is kinda deleted... weird stuff!
})


#
#' $
#' overwrite the $ function..
#' 
# the variable names are important! they need to be the same as in the R source... else i get:
### Error in match.call(definition, call, expand.dots) : 
###  unused arguments (self = c("Data", ""), name = c("ANY", ""))
# getGeneric("$")
# it says: 
## standardGeneric for "$" defined from package "base"
## 
## function (x, name) 
##   standardGeneric("$", .Primitive("$"))
## <bytecode: 0x0ad56620>
##   <environment: 0x0914d0c0>
##   Methods may be defined for arguments: x
## Use  showMethods("$")  for currently available ones.
#
# only x may be defined, so "name" may not be in the signature...
# but may still be in function.... right... like a unique key thingy...
#' @description
#' this function automatically determines the data level based on row number...
#' as a consequence data is not automatically repeated if its not of the right length for new colums
#'
#' @param x the MicroPlate object
#' @param name the name of the column you want returned
#' 
#' @export
setMethod("$", signature(x = "MicroPlate"), function(x, name) {
  # 
  # check if the col name is valid
  if(!any(x@.data$colNames==name)){
    warning(paste("not a valid colname given, valid colnames are: ",paste(x@.data$colNames,collapse=", ")))
    return(NULL)
  }
  level=x@.data$colLevel[x@.data$colNames==name]
  if (is.null(level)){
    # remove this once i implemented $= properly
    print("ok this shouldn't happen... but it did!") # change in a warning later...
    return(x@.data$well[[name]])
  }
  
  # return the column
  if (level=="well"){
    return(x@.data$well[[name]])
  } else if(level=="measurement"){
    return(x@.data$measurement[[name]])
  } else if(level=="plate") {
    return(x@.data$plate[[name]])
  } else {
    warning("data at unknown level")
  }
  
})


#' $<-
#' overwrite the $<- function
#' 
#' @description
#' if given a new column name, the data will use row number to determine the level
#' if the row number does not equal the size of any of the data levels, an error is thrown
#' 
#' for known columns a single value can be given that will be replicated
#' =NULL will remove the column
#' 
#' 
#' @param x the MicroPlate object
#' @param name the name of the column you want to create/add to
#' @param value the new value, this should be of the correct length
#' 
#' @export
setMethod("$<-", signature(x = "MicroPlate"), function(x, name, value) {
  # check if its a valid colname
  if (any(x@.data$reservedNames==name)){
    stop(paste("The following names are reserved for other purposes!: ",paste(x@.data$reservedNames,sep=", "), sep=""))
  }
  # check if mp$name=NULL
  if(is.null(value)){
    return(removeColumn(x,name))
  }
  
  # determine level
  level=NULL
  if(any(x@.data$colNames==name)){ # is it an existing variable?
    level=x@.data$colLevel[x@.data$colNames==name]
    #
    # overwrite is more flexible in that a single value can be repeated
    levelSize=x@.data$levelSize[x@.data$levelNr==x@.data$colLevelNr[x@.data$colNames==name]]
    if(levelSize!=length(value)){
      if(length(value)==1){
        value=rep(value,levelSize)
      }else{
        stop("levelsize does not match valuesize")
      }
    }
    
  }else if(!any(x@.data$levelSize==length(value))){ # does the data size match any of the level sizes
    stop(paste("given rows do not match any of the levels!"))
  }else{
    level=x@.data$level[x@.data$levelSize==length(value)]
  }
  
  if(length(level)>1){
    # multiple levels had the same sizes...
    # add it to the highest #TODO or add it to the lowest??? that has its advantages...
    level=x@.data$level[x@.data$levelNr==max(x@.data$levelNr[x@.data$level %in% level])]
  }
    
  # check if the name matches the level size...


  
  if (level=="plate") {
    x@.data$plate[name]=value
  } else if (level=="well") {
    x@.data$well[[name]]=value
  } else if (level=="measurement") {
    x@.data$measurement[[name]]=value
  } else {
    stop("unknown level!!!")
  }
  
  # check if was an existing colname
  if(!any(x@.data$colNames==name)){
    updateMetaData(x)
#     print(paste("new column:",name," added at level:",level,sep=""))
  }

  return(x)
})


#' overwrtie colnames
#' 
#' @description
#' returns the column names (hiddes internal names)
#' 
#' TODO:make sure this does not overwrite data.frame/base colname function
#' 
#' @param x the MicroPlate object you want the column names from
#' 
#' @export
setMethod("colnames", signature(x = "MicroPlate"), function(x) {
  return(x@.data$colNames)
})


#' overwrite colnames<-
#' 
#' TODO: BROKEN!
#' TODO: decide if i want this funtion
#' 
#' @description
#' overwrite the column names 
#' 
#' 
#' @param x the MicroPlate object
#' @param value the new column names
#' 
#' @export
setMethod("colnames<-", signature(x = "MicroPlate"), function(x, value) {
  # TODO add checks! if its the same size as data... and you probably dont want to change this anyways...
  stop("no longer supported for now!")
  
  if(length(value)!=length(x@.data$colNames)){
    stop("invalid number of column names, please don't try again!")
  }
  
    
  
  warning("you are adviced not to do this!... but you already did...")
  x@.data$colNames=value
#   length(x@.data$colLevel!=2)
  names(x@.data$plate)=value[1:length(x@.data$colLevel==3)]
  names(x@.data$data)=value[length(x@.data$colLevel==3)+1:length(value)]
  # all measurements...
  
  
  #   return(x@.data$colnames)
  return(x) # for some reason i have to do this, else the instance of the class transforms into the value passed...
})


#' overwrite show()
#' 
#' @description
#' prints the data of the object in it's primative form
#' 
#' 
#' slot needs to be named "object"
#'  
#' still gives error:
#' > testData
#' Object of class "MicroPlate"
#' Error in S3Part(object, strictS3 = TRUE) : 
#'  S3Part() is only defined for classes set up by setOldCLass(), basic classes or subclasses of these:  not true of class "MicroPlate"
#' 
#' @param object the Microplate object
#' 
#' 
#' @export
setMethod("show", signature(object = "MicroPlate"), function(object) {
  print("measurement data:")
  print(object@.data$measurement)
  print("well data:")
  print(object@.data$well)
  print("plate data:")
  print(object@.data$plate)
  return(object)
})


#' overwrite print()
#' @export
#' @rdname print
#' @description
#' just calls show(x)
#' @param x the MicroPlate object
#' @param ... not used but roxygen complains without this
#' 
setGeneric("print", function(x) standardGeneric("print"))
#' @rdname print
setMethod("print", signature(x = "MicroPlate"), function(x) {
#   print("oooh you want to know my secrets???... well they are secret!!!")
#   x@.data
  return(show(x))
})


#' plotPerWell
#' @rdname plotPerWell
#' @description
#' TODO: add huge amounts of checks and stuff
#' 
#' @param self the MicroPlate object
#' 
#' @export
setGeneric("plotPerWell", function(self) standardGeneric("plotPerWell")) 
#' @rdname plotPerWell
setMethod("plotPerWell", signature(self = "MicroPlate"), function(self){
  origenalPar=par(no.readonly=T) # backup plotting pars
  nrOfWells=self@.data$levelSize[2]
    
  for(i in 1:nrOfWells){
    
    index=getWellsMeasurementIndex(self,i)
#     print(index)
    start=index[[1]]
    end=index[[2]]
    print(start)
    print(end)
    
    plot(x=self@.data$measurement$time[start:end],y=self@.data$measurement$value[start:end],main=self@.data$well$content[[i]]) 
#     data=self@.data$measurement[selection,]
#     plot(x=data$time,y=data$value,main=self@.data$data$content[[i]]) 
  }



#   
#   par(oma=c(1,1,0,0), mar=c(1,1,1,0), tcl=-0.1, mgp=c(0,0,0))#test
#   for(i in wells){
#     data=self@.data$data$measurement[[i]]
#     plot(x=data$time,y=data$value,main=self@.data$data$content[[i]]) 
#   }
# 
#   par(origenalPar) # restore pars...
  suppressWarnings(par(origenalPar)) # restore pars... this can give warnings for some reason..

#   resetPar()
  return(self)
})


#' plotPerPlate
#' @rdname plotPerPlate
#' @description
#' TODO: add huge amounts of checks and stuff
#' todo: what if not on measurement level?
#' todo: multiple wavelengths
#' 
#' @param self the MicroPlate object
#' @param x the name of the x col, needs to be at measurement level for now
#' @param y the name of the y col, needs to be at measurement level for now
#' 
#' @export
setGeneric("plotPerPlate", function(self, x="time",y="value") standardGeneric("plotPerPlate")) 
#' @rdname plotPerPlate
setMethod("plotPerPlate", signature(self = "MicroPlate"), function(self, x="time",y="value"){
#   dev.new()#dont use rstudio window
  origenalPar=par(no.readonly=T) # backup plotting pars
  nrOfPlates=self@.data$levelSize[3]
  nrOfWells=self@.data$levelSize[2]
  
  firstMeasurementNr=1
  lastMeasurementNr=0
  
  for(plateNr in 1:nrOfPlates){
    wells=(1:nrOfWells)[self@.data$well$plate==plateNr]
#     print(wells)
    #get amount of row/columns
    nrRows=max(self@.data$well$row[wells])-min(self@.data$well$row[wells])+1
    nrColumns=max(self@.data$well$column[wells])-min(self@.data$well$row[wells])+1
    
    
    # create a NA grid
#     par(mfcol=c(nrRows,nrColumns))
#     layoutMatrix=matrix(data=0,nrow=nrRows,ncol=nrColumns)
#     for(i in 1:length(wells)){
#       layoutMatrix[self@.data$well$row[wells[i]],self@.data$well$column[wells[i]]]=i
#     }
#     print(layoutMatrix)
#     print(nrRows)
#     print(nrColumns)
#     layout(mat=layoutMatrix,nrRows,nrColumns)
  
#     layout.show(length(wells)) # this takes a while
    
#     par(oma=c(1,1,0,0), mar=c(1,1,1,0), tcl=-0.1, mgp=c(0,0,0))#test

    lastMeasurementNr=lastMeasurementNr+self@.data$measurementsPerPlate[plateNr]
    index=firstMeasurementNr:lastMeasurementNr
    xlim=c(min(self@.data$measurement[[x]][index]),max(self@.data$measurement[[x]][index]))
    ylim=c(min(self@.data$measurement[[y]][index]),max(self@.data$measurement[[y]][index]))

#     print(paste("index: ",firstMeasurementNr,":",lastMeasurementNr,sep=""))
#     print(paste("xlim:",xlim,"ylim",ylim,sep=" "))
#     print("---")

    par(mfrow = c(nrRows,nrColumns), mai=c(0,0,0,0), oma=c(1,1,1,1), ann=FALSE, xaxt="n",yaxt="n" )
    for(i in wells){
      selection=getWellsMeasurementIndex(self,i)
#       print(selection)
      time=self@.data$measurement[[x]][selection]
      value=self@.data$measurement[[y]][selection]
      plot(x=time,y=value,xlim=xlim,ylim=ylim, type="l")
#       plot(x=time,y=value,main=self@.data$well$content[[i]]) 
    }#well
    firstMeasurementNr=lastMeasurementNr+1 # not so much a +1 increase as its a first=last
    
  }# plate
  suppressWarnings(par(origenalPar)) # restore pars... this can give warnings for some reason..
#   return(self)
#   return()
#   resetPar()
})


# #' MicroPlate apply
# #' MPApply
# #' @@rdname MPApply
# #' @@description 
# #' 
# #' 
# #' TODO make it accept more complex things!
# #' maybe make it an interface to an existing apply like function
# #' TODO support formulas!!!
# #' 
# #' @@param self the MicroPlate object
# #' @@param fun the function 
# #' @@param ... ...
# #' 
# #' @@export
# setGeneric("MPApply", function(self, fun, what="value", wellNrs=NULL, forEach="time", ...) standardGeneric("MPApply"))
# #' @@rdname MPApply
# setMethod("MPApply", signature(self = "MicroPlate"), function(self, fun, what="value", wellNrs=NULL, forEach="time", ...){
# #   funcall=substitute(fun(...))
# #   x="time"
# #   y="value"
# #   
# #   # for now no input... need to studie formula first....
# #   results=list()
# #   # for each well
# #   for(i in 1:self@.data$levelSize[2]){
# #     x=self@.data$data$measurement[[i]][["time"]]
# #     y=self@.data$data$measurement[[i]][["value"]]
# #     results[i]=list(do.call(what=fun,args=list(x=x,y=y,unlist(list(...)))))
# #   }
#   
#   ### check input
#   # wellNrs
# #   if(is.null(wellNrs)) wellNrs=1:self@.data$levelSize[2] # if not specified get it for everything
# #   if(is.logical(wellNrs)){
# #     if(length(wellNrs)==self@.data$levelSize[2]){ #well
# #       wellNrs=(1:self@.data$levelSize[2])[wellNrs]
# #     }else if(length(wellNrs)==self@.data$levelSize[1]){#measurement
# #       wellNrs=(1:self@.data$levelSize[1])[wellNrs]
# #     }else{# else... maybe add plate..
# #       stop(paste("nr of wells: ",self@.data$levelSize[2] ," your selection: ",length(wellNrs), sep=""))
# #     }
# #   }
#   
# #   level=
# #   if(level==3){ # plate
# #     
# #   }else if(level=2){ # well
# #     
# #   }else if(level=1){# measurement
# #     
# #   }else{
# #     stop("unknown level")
# #   }
#   rows=wellNrs
#     
#   
#     
#   
#   
# #   what="value"
# #   forEach="time"
#   
#   uniques=unique(self[rows,forEach])
#   
#   #TODO what if not the same level??
#   #always get lowest?
#   
#   results=list()
#   for(i in uniques){
# #     print(self[rows,forEach])
#     x=unlist(self[self[forEach]==i,what])
# #     print(x)
# #     print(list(do.call(what=fun,args=list(x))))
# #     print("---------------")
#     results[i]=list(do.call(what=fun,args=list(x)))
#     
# #     results[i]=list(do.call(what=fun,args=list(x=x,y=y,unlist(list(...)))))
#   }
#   
#   
#   
#   return(results)
# 
# })


#' copy
#' @rdname copy
#' @description
#' make a copy of the MicroPlate data instance
#' this function is used to get around the default behaviour
#' 
#' @param self the MicroPlate object
#' 
#' @export
setGeneric("copy", function(self) standardGeneric("copy"))
#' @rdname copy
setMethod("copy", signature(self = "MicroPlate"), function(self){
  copy=new("MicroPlate")
  listOldVars=ls(envir=self@.data, all.names=T)
  for(i in listOldVars){
    copy@.data[[i]]=self@.data[[i]]
  }
  # this could even be an lapply?  
  return(copy)
})


#' dim
#' @rdname dim
#' @description
#' return the diminsions of the MicroPlate
#' 
#' @param x the MicroPlate object
#' 
#' TODO figure out if i can add level to this beauty
#' TODO figure out about non primative columns
#' 
#' @export
setMethod("dim", signature(x = "MicroPlate"), function(x){
  level="measurement"
  return(dim(x[level=level]))
#   return(c( self@.data$levelSize[self@.data$level=="measurement"], length(self@.data$colNames) ) )
})



#' getWellsMeasurementIndex
#' @rdname getWellsMeasurementIndex
#' @description
#' get start and end coordinates of the requested well measurements in the measurement 'table'
#' 
#' NEEDS A BETTER NAME
#' 
#' @param self the MicroPlate object
#' @param wellNr the well you want the measurement row numbers from
#'  
#' @export
setGeneric("getWellsMeasurementIndex", function(self,wellNr) standardGeneric("getWellsMeasurementIndex"))
#' @rdname getWellsMeasurementIndex
setMethod("getWellsMeasurementIndex", signature(self = "MicroPlate"), function(self, wellNr){
  nrOfMeasurement=0
  i=wellNr
  
  # check if the well given was the last well
  if(!is.na(self@.data$well$measurement[i+1])){
    nrOfMeasurement=self@.data$well$measurement[[i+1]]-self@.data$well$measurement[[i]]
  }else{
    # last well
    nrOfMeasurement=length(self@.data$measurement[[1]])-self@.data$well$measurement[[i]]+1
  }
  end=self@.data$well$measurement[i]+nrOfMeasurement-1 # the -1 is cause the start is also included
  return(self@.data$well$measurement[i]:end)
#   return(data.frame(start=self@.data$well$measurement[i],end=end,stringsAsFactors = F))
})


#' getPlatesMeasurementIndex
#' @rdname getPlatesMeasurementIndex
#' @description
#' get start and end coordinates of the requested well measurements in the measurement 'table'
#' 
#' NEEDS A BETTER NAME
#' 
#' @param mp the MicroPlate object
#' @param plateNr the plate you want the measurement row numbers from
#'  
#' @export
setGeneric("getPlatesMeasurementIndex", function(mp,plateNr) standardGeneric("getPlatesMeasurementIndex"))
#' @rdname getPlatesMeasurementIndex
setMethod("getPlatesMeasurementIndex", signature(mp = "MicroPlate"), function(mp, plateNr){
  first=mp@.data$firstMeasurmentRowNrPerPlate[plateNr]
  return(first:(first+mp@.data$measurementsPerPlate[plateNr]-1))
})


#' getPlatesWellIndex
#' @rdname getPlatesWellIndex
#' @description
#' get start and end coordinates of the requested well measurements in the measurement 'table'
#' 
#' NEEDS A BETTER NAME
#' 
#' @param mp the MicroPlate object
#' @param plateNr the plate you want the measurement row numbers from
#'  
#' @export
setGeneric("getPlatesWellIndex", function(mp,plateNr) standardGeneric("getPlatesWellIndex"))
#' @rdname getPlatesWellIndex
setMethod("getPlatesWellIndex", signature(mp = "MicroPlate"), function(mp, plateNr){
  first=1
  for(i in 1:mp@.data$levelSize[3]){ # for each plate
    if(i==plateNr) return(first:(first+mp@.data$wellsPerPlate[i]-1))
    first=first+mp@.data$wellsPerPlate[i]
  }
  stop("invalid plateNr????")
})


#' showWellNrs
#' 
#' @param mp the MicroPlate object
#' 
#' plots the plates and shows the well nr...
#' color is based on OD if present else its green
#' 
#' todo: check wavelength properly per well
#' todo: decide if multiple wavelengths (multiple plots)
#' todo: decide if i need to change maxOD per plate(as it is now) or global... 
#' todo: test for bigger other than 96 well plates. 
#' 
#' @export
#' @import shape
showWellNrs=function(mp){
  origenalPar=par(no.readonly=T) # backup plotting pars
  
  firstWellNumber=0
  lastWellNumber=0
  
  # is there a wavelength column
#   wellColor="#FFFFFF" # default color=white
  plateCol="#00FF00" # green is default
  if(!is.null(suppressWarnings(mp$waveLength[1]))){
    plateCol=waveLengthToRGBString(mp$waveLength[1])
  }
  
  colFunc=colorRampPalette(c("white", plateCol))
  colGradient=colFunc(100)
  
  # well numbers continue over different plates
  # so it should plot all plates
  for(plateNumber in 1:mp@.data$levelSize[3]){
    # set variables for next
    firstWellNumber=lastWellNumber+1
    lastWellNumber=lastWellNumber+mp@.data$wellsPerPlate[plateNumber]
    selection=firstWellNumber:lastWellNumber
        
    nrOfRows=max(mp@.data$well$row[selection])
    nrOfColumns=max(mp@.data$well$column[selection])
    
    maxODOfPlate=max(mp$value[getPlatesMeasurementIndex(mp,plateNumber)])
    minODOfPlate=min(mp$value[getPlatesMeasurementIndex(mp,plateNumber)])
    
    
#    wellColor=c(255,255,255) # white
    
    plot.new()
    plot.window(xlim=c(1,nrOfColumns),ylim=c(-1,nrOfRows))
    if(!is.null(suppressWarnings(mp$waveLength[1]))){
      title(paste("WellNrs plate: ",plateNumber," at wavelength: " , mp$waveLength[1], sep=""))
    }else{
      title(paste("WellNrs plate: ",plateNumber, sep=""))
    }
#     filledmultigonal(mid=c(nrOfColumns/2,nrOfRows/2),rx=nrOfColumns/2,ry=nrOfRows/2,nr=4,angle=45,col="lightblue1")
#     roundrect(mid = c(nrOfColumns/2,nrOfRows/2),radx=nrOfColumns/2,rady=nrOfRows/2)
#     rect(xleft=1,ybottom=-1,xright=nrOfColumns,ytop=nrOfRows,col="lightblue1")
#     rect(xleft=-2,ybottom=-1,xright=nrOfColumns+2,ytop=nrOfRows,col="white")
    
    for(wellNr in selection){
      maxOD=max(mp@.data$measurement$value[getWellsMeasurementIndex(mp,wellNr)])
      
      wellColor=colGradient[ceiling(((maxOD-minODOfPlate)/(maxODOfPlate-minODOfPlate))*100)]
      
      filledcylinder(mid=c(mp@.data$well$column[wellNr],nrOfRows-mp@.data$well$row[wellNr]),rx=0.4, ry=0.4,len=0.2, angle = 90, col=wellColor,topcol=wellColor,botcol=wellColor, lcol = "black", lcolint = "grey")  
      text(mp@.data$well$column[wellNr],nrOfRows-mp@.data$well$row[wellNr],wellNr,cex=0.7)
    }
  }
  suppressWarnings(par(origenalPar)) # restore pars... this can give warnings for some reason..
#   resetPar()
}


# setMethod("+",
#           signature(e1 = "character", e2 = "character"),
#           function (e1, e2) {
#             paste(e1, e2, sep = "")
#           })


##
## stuff from the book: 
## Chambers, "Software for data analysis", Springer, 2008.
## chapter 10
# setMethod("==", c("track", "track"),
#           function(e1, e2) {
#             e1@x == e2@x &
#               e1@y == e2@y
#           })
# setMethod("!=", c("track", "track"),
#           function(e1, e2) {
#             e1@x != e2@x |
#               e1@y != e2@y
#           })
# setMethod("Compare", c("track", "track"),
#           function(e1, e2) {
#             cmpx <- callGeneric(e1@x, e2@x)
#             cmpy <- callGeneric(e1@y, e2@y)
#             ifelse(cmpx & cmpy, TRUE,
#                    ifelse(cmpx | cmpy, NA, FALSE))
#           })
# setMethod("[",
#           signature(x = "trackNumeric", i = "ANY", j = "missing"),
#           function(x, i) {
#             x@.Data[i]
#           })


####
phonixor/MicroPlate documentation built on May 25, 2019, 6:01 a.m.