#' Calculates correlation of shifted vectors
#'
#' This function is for calculating the correlation between two vectors \code{x}
#' and \code{y}. The vectors are shifted \code{n} times by \code{p} elements.
#' This relates to shifted n number of concentrations in either direction, each
#' concentration shift being a multiple of the number of features.
#'
#' @param x vector
#' @param y vector
#' @param n integer. The number of titrations shifts in either directions. i.e
#' \code{n = 2} will shift 2 titrations to the left, and 2 to the right. If n
#' is not directly given, then it will be calculated from by half the number of
#' concentrations in the metadata (to the nearest integer).
#' @param p interger. The number of features. \code{n} will always be a multiple
#' of \code{p}. This is so identical features are always aligned despite
#' titration shifts.
#' @param metadata optional metadata object produced from
#' \code{construct_metadata}. Used to extract values for n and p
#' if none are given.
#'
#' @return cor_measurements vector of correlations for each shift
#'
#' @export
#'
#' @examples
#' # create dummy dataset
#' l <- list()
#' for (i in 1:100) l[[i]] <- rnorm(100)
#' df <- as.data.frame(l)
#' names(df) <- paste("col", 1:100, sep = "_")
#' # order values (more obvious correlation shifts)
#' df <- apply(df, 2, sort)
#' out <- trim_cor(df[,1], df[,2], n = 5, p = 5)
#' plot(out, type = "l")
#'
#' # plot all correlations
#' out <- trim_cor(df[,1], df[,2], 20, 3)
#' plot(out,
#' type = "l",
#' xaxt = "n",
#' ylab = "correlation",
#' main = "col_1 vs all correlation",
#' sub = "20 shifts, 3 elements each")
#' axis(1, at = 1:41,
#' labels = names(out))
#' for (i in 3:ncol(df)){
#' lines(trim_cor(df[,1], df[,i], 20, 3), col = "gray50")
#' }
trim_cor <- function(x, y, n = NULL, p = NULL, metadata = NULL){
if (!is.null(metadata)){
# check if given metadta that it's a valid metadata object
if (class(metadata) != 'metadata'){
stop("Metadata has to be a metadata object calculated by 'construct_metadata()'")
}
# calculate n and p from the metadata
n <- as.integer(length(metadata$concentrations) / 2)
p <- length(metadata$feature_cols)
}
if (!is.null(n) && !is.null(p)){
# use the values given
n <- n
p <- p
}
cor_measurements <- vector(length = 2 * n + 1)
# left shift from -n to -1
for (i in n:1){
x_tmp <- tail(x, - i * p)
y_tmp <- head(y, - i * p)
cor_measurements[i] <- cor(x_tmp, y_tmp)
}
# reverse measurements so that they are in the correct order
# going from -n -> 0 -> +n
cor_measurements[1:n] <- rev(cor_measurements[1:n])
# cor of unshifted x and y
cor_measurements[n + 1] <- cor(x, y)
# right shift from 1 to n
for (i in 1:n){
x_tmp <- head(x, - i * p)
y_tmp <- tail(y, - i * p)
cor_measurements[n + 1 + i] <- cor(x_tmp, y_tmp)
}
# name of shift in vector of correlation values
names(cor_measurements)[1:n] <- paste("-", n:1)
names(cor_measurements)[n + 1] <- 0
names(cor_measurements)[(n + 2):length(cor_measurements)] <- paste('+', 1:n)
# create class for plot_trim_cor
class(cor_measurements) <- "cor_vector"
return(cor_measurements)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.