R/fit_in_matrix_cells.R

In dimitriskokoretsis/qpcrR:

.fit_in_matrix_cells <- function(n,m,free.value,occupied.value,occupied.cells=NULL) {
  # This function is supposed to enter a group of reactions in a matrix (plate), based on its existing free repeats.
  # Should handle reaction groups that DO NOT fit in continuous free lines in a plate, by breaking them up.

  # n is the number of reactions to be put in the matrix
  # m is the matrix
  # free.value is the value of the matrix that constitutes a free cell

  # n should be a vector, so it can have multiple elements.
  # n will be sorted in the beginning of the function, in descending order.
  # First, fit all n elements that CAN be fitted in the matrix as they are
  # The n elements that cannot fit in any line should be split in two and the function should be called recursively until all are put in.

  # The function should return a list of 2 vectors, with row and column indices

  # Transferring the matrix.free.repeats in each recursion (?)


  # Errors:
  # 1. If the free.value or occupied.value are not of length 1.
  # 2. If the type of free.value or occupied.value is not of the same type as that of m.

  free.lines <- .matrix_repeats(m,free.value,use.line.names=FALSE)

  if((length(free.value) != 1) | (length(occupied.value) != 1)) {
    stop("free.value and occupied.value must have length 1.")
  }

  if((typeof(free.value) != typeof(m)) | (typeof(occupied.value) != typeof(m))) {
    stop("free.value and occupied.value must be of the same type as m.")
  }

  if(sum(n) > sum(free.lines[,length])) {
    stop("Matrix does not have enough free cells.")
  }

  n <- sort(n,decreasing=TRUE)
  n.fitted <- rep(FALSE,times=length(n))
  new.n <- integer()

  # Take each n element and try to put it in existing free lines of the matrix
  # If it can be put as a whole, switch its corresponding n.fitted element to TRUE
  for(i in 1:length(n)) {
    free.lines <- .matrix_repeats(m,free.value,use.line.names=FALSE)

    if(nrow(free.lines[length>=n[i]]) > 0) {
      # If there is at least one line that can fit n[i]
      n.fitted[i] <- TRUE
      line.for.use <- free.lines[length>=n[i]][order(-(length-n[i]))][1]

      if(line.for.use[,orientation]=="horizontal") {
        new.occupied.cells <- list(row=line.for.use[,row.or.column.name],
                                   column=seq(line.for.use[,start],length.out=n[i]))

      } else {
        new.occupied.cells <- list(row=seq(line.for.use[,start],length.out=n[i]),
                                   column=line.for.use[,row.or.column.name])

      }
      # Change matrix cells
      m[cbind(new.occupied.cells[[1]],new.occupied.cells[[2]])] <- occupied.value

      # Update occupied cell data
      occupied.cells <- data.table::rbindlist(list(occupied.cells,
                                                   new.occupied.cells))

    } else {
      new.n <- c(new.n,
                 n[i] - n[i] %/% 2,
                 n[i] %/% 2)

    }
  }

  # If there are still remaining elements in n (check n.fitted for that)
  if(sum(n.fitted) < length(n.fitted)) {
    return(.fit_in_matrix_cells(n=new.n,
                                m=m,
                                free.value=free.value,
                                occupied.value=occupied.value,
                                occupied.cells=occupied.cells))

  } else {
    # Return the resulting wells
    return(occupied.cells)

  }

}