Détails de snippet

Diminution de la taille d'une matrice[R]

2018-07-04     gdevailly     matrice interpolation heatmap 

  Ploter une grosse matrice sous forme d'heatmap peut prendre du temps.
Il peux être judicieux de réduire la taille de la matrice avant de la ploter, en moyennant des groupes de cellules adjacentes (ou en prenant le maximum, lorsque la matrice est 'sparse').
C'est notamment utile lorsqu'il y a beaucoup plus de cellules que de pixels sur les écran actuels (par exemple, ploter 80 000 régions génomiques sur un écran HD de 1080 pixels de hauts).

Utilisation:

> bigmat <- matrix(1:64, ncol = 8)
> bigmat
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 1 9 17 25 33 41 49 57
[2,] 2 10 18 26 34 42 50 58
[3,] 3 11 19 27 35 43 51 59
[4,] 4 12 20 28 36 44 52 60
[5,] 5 13 21 29 37 45 53 61
[6,] 6 14 22 30 38 46 54 62
[7,] 7 15 23 31 39 47 55 63
[8,] 8 16 24 32 40 48 56 64
> # default usage
> redim_matrix(bigmat, target_height = 4, target_width = 3)
[,1] [,2] [,3]
[1,] 10.0 30.0 50.0
[2,] 11.5 31.5 51.5
[3,] 13.0 33.0 53.0
[4,] 15.0 35.0 55.0
> # changing aggregating function
> redim_matrix(bigmat, target_height = 4, target_width = 3, summary_func = function(x) max(x, na.rm = TRUE))
[,1] [,2] [,3]
[1,] 19 43 59
[2,] 20 44 60
[3,] 22 46 62
[4,] 24 48 64
> # multicore
> redim_matrix(bigmat, target_height = 4, target_width = 3, n_core = 2)
[,1] [,2] [,3]
[1,] 10.0 30.0 50.0
[2,] 11.5 31.5 51.5
[3,] 13.0 33.0 53.0
[4,] 15.0 35.0 55.0
# reduce matrix size, using a summarizing function (default, mean)
redim_matrix <- function(
    mat,
    target_height = 100,
    target_width = 100,
    summary_func = function(x) mean(x, na.rm = TRUE),
    n_core = 1
    ) {

    if(target_height > nrow(mat) | target_width > ncol(mat)) {
        stop("Input matrix must be bigger than target width and height.")
    }

    seq_height <- round(seq(1, nrow(mat), length.out = target_height + 1))
    seq_width  <- round(seq(1, ncol(mat), length.out = target_width  + 1))

    # complicate way to write a double for loop
    do.call(rbind, parallel::mclapply(seq_len(target_height), function(i) { # i is row
        vapply(seq_len(target_width), function(j) { # j is column
            summary_func(
                mat[
                    seq(seq_height[i], seq_height[i + 1]),
                    seq(seq_width[j] , seq_width[j + 1] )
                    ]
            )
        }, 0.0)
    }, mc.cores = n_core))
}
5/5 - [ rating]