library(dipsaus)
set.seed(1)
# Generate sample data
dims = c(10,20,30,2)
x = array(rnorm(prod(dims))^2, dims)
# Set baseline window to be arbitrary 10 timepoints
baseline_window = sample(30, 10)
# ----- baseline percentage change ------
# Using base functions
re1 <- aperm(apply(x, c(1,2,4), function(y){
m <- mean(y[baseline_window])
(y/m - 1) * 100
}), c(2,3,1,4))
# Using dipsaus
re2 <- baseline_array(x, 3, baseline_window, c(1,2,4),
method = 'percentage')
# Check different, should be very tiny (double precisions)
range(re2 - re1)
# Check speed for large dataset
if(interactive()){
dims = c(200,20,300,2)
x = array(rnorm(prod(dims))^2, dims)
# Set baseline window to be arbitrary 10 timepoints
baseline_window = seq_len(100)
f1 <- function(){
aperm(apply(x, c(1,2,4), function(y){
m <- mean(y[baseline_window])
(y/m - 1) * 100
}), c(2,3,1,4))
}
f2 <- function(){
# equivalent as bl = x[,,baseline_window, ]
#
baseline_array(x, along_dim = 3,
baseline_indexpoints = baseline_window,
unit_dims = c(1,2,4), method = 'sqrt_percentage')
}
microbenchmark::microbenchmark(f1(), f2(), times = 3L)
}
Run the code above in your browser using DataLab