rgplotsviridis

viridis with colorRampPalette output different vector lengths in R


I'm having some trouble to assign specific colors to a numeric vector. My interest is to use VAR1.color in as the ColSidecolors in heatmap.2. My data frame has 1655 rows with no missing values. I produce the colorRampPalette vector with the max of VAR1, however, when I use the function to create a vector of equal length as to assign a color to each observation, the resulting color vector is of a different length than the original.

31  > var2Color <- colorRampPalette(viridis(ceiling(max(mm$VAR2)), option = "A"))                                                                                                                                                             
32  > mm$VAR2.color <- var2Color(ceiling(max(mm$VAR2)))[mm$VAR2]                                                                                                                                                                              
33  Error in `$<-.data.frame`(`*tmp*`, VAR2.color, value = c("#010005", "#020109",  :
34    replacement has 1643 rows, data has 1655

Could anyone help check where the error in my code is ? has anyone seen this before ?

I'm providing the code I used to replicate the error on two ocasions, and sessionInfo() details.

Any help will be much appreciated.

code

library(viridis)
set.seed(81)

## random values that best replicate my data
mm <- data.frame(VAR1 = abs(rnorm(n = 1655, 2, 100)), 
                 VAR2 = abs(rnorm(n = 1655, 2, 88)))
head(mm)

dim(mm)
any(is.na(mm))

var1Color <- colorRampPalette(viridis(ceiling(max(mm$VAR1)), option = "A"))
mm$VAR1.color <- var1Color(ceiling(max(mm$VAR1)))[mm$VAR1]

mm$VAR1.color <- NA
mm$VAR1.color <- var1Color(ceiling(max(mm$VAR1)))[mm$VAR1]

any(is.na(mm$VAR2))
var2Color <- colorRampPalette(viridis(ceiling(max(mm$VAR2)), option = "A"))
mm$VAR2.color <- var2Color(ceiling(max(mm$VAR2)))[mm$VAR2]

sessionInfo()

Session output

1   > library(viridis)                                                                                                                                                                                                                        
2   > set.seed(81)                                                                                                                                                                                                                            
3   >                                                                                                                                                                                                                                         
4   > mm <- data.frame(VAR1 = abs(rnorm(n = 1655, 2, 100)), 
                       VAR2 = abs(rnorm(n = 1655, 2, 88)))                                                                                                                                               
5   > head(mm)                                                                                                                                                                                                                                
6          VAR1       VAR2
7   1 101.50747   2.436640
8   2  50.82978   5.620249
9   3  88.32233  11.304224
10  4  58.74447  92.727843
11  5  32.13192 141.090015
12  6  12.21342   5.785531
13  >                                                                                                                                                                                                                                         
14  > dim(mm)                                                                                                                                                                                                                                 
15  [1] 1655    2
16  > any(is.na(mm))                                                                                                                                                                                                                          
17  [1] FALSE
18  >                                                                                                                                                                                                                                         
19  > var1Color <- colorRampPalette(viridis(ceiling(max(mm$VAR1)), option = "A"))                                                                                                                                                             
20  > mm$VAR1.color <- var1Color(ceiling(max(mm$VAR1)))[mm$VAR1]                                                                                                                                                                              
21  Error in `$<-.data.frame`(`*tmp*`, VAR1.color, value = c("#651A80", "#251254",  :
22    replacement has 1641 rows, data has 1655
23  >                                                                                                                                                                                                                                         
24  > mm$VAR1.color <- NA                                                                                                                                                                                                                     
25  > mm$VAR1.color <- var1Color(ceiling(max(mm$VAR1)))[mm$VAR1]                                                                                                                                                                              
26  Error in `$<-.data.frame`(`*tmp*`, VAR1.color, value = c("#651A80", "#251254",  :
27    replacement has 1641 rows, data has 1655
28  >                                                                                                                                                                                                                                         
29  > any(is.na(mm$VAR2))                                                                                                                                                                                                                     
30  [1] FALSE
31  > var2Color <- colorRampPalette(viridis(ceiling(max(mm$VAR2)), option = "A"))                                                                                                                                                             
32  > mm$VAR2.color <- var2Color(ceiling(max(mm$VAR2)))[mm$VAR2]                                                                                                                                                                              
33  Error in `$<-.data.frame`(`*tmp*`, VAR2.color, value = c("#010005", "#020109",  :
34    replacement has 1643 rows, data has 1655
35  >                                                                                                                                                                                                                                         
36  > sessionInfo()                                                                                                                                                                                                                           
37  R Under development (unstable) (2018-10-16 r75445)
38  Platform: x86_64-apple-darwin16.7.0 (64-bit)
39  Running under: macOS Sierra 10.12.6
40 
41  Matrix products: default
42  BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
43  LAPACK: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libLAPACK.dylib
44 
45  locale:
46  [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
47 
48  attached base packages:
49  [1] parallel  stats     graphics  grDevices utils     datasets  methods
50  [8] base
51 
52  other attached packages:
53   [1] wesanderson_0.3.6   RColorBrewer_1.1-2  viridis_0.5.1
54   [4] viridisLite_0.3.0   multcomp_1.4-8      TH.data_1.0-10
55   [7] MASS_7.3-51         survival_2.42-6     mvtnorm_1.0-8
56  [10] factoextra_1.0.5    ggfortify_0.4.5     ggplot2_3.1.0
57  [13] pheatmap_1.0.12     copynumber_1.23.0   BiocGenerics_0.29.1
58  [16] vegan_2.5-4         lattice_0.20-35     permute_0.9-4
59  [19] gplots_3.0.1
60 
61  loaded via a namespace (and not attached):
62   [1] ggrepel_0.8.0          Rcpp_1.0.0             tidyr_0.8.2
63   [4] zoo_1.8-4              gtools_3.8.1           assertthat_0.2.0
64   [7] R6_2.4.0               GenomeInfoDb_1.19.2    plyr_1.8.4
65  [10] stats4_3.6.0           pillar_1.3.1           zlibbioc_1.29.0
66  [13] rlang_0.3.1            lazyeval_0.2.1         gdata_2.18.0
67  [16] S4Vectors_0.21.10      Matrix_1.2-14          splines_3.6.0
68  [19] stringr_1.4.0          RCurl_1.95-4.11        munsell_0.5.0
69  [22] compiler_3.6.0         pkgconfig_2.0.2        mgcv_1.8-24
70  [25] tidyselect_0.2.5       tibble_2.0.1           gridExtra_2.3
71  [28] GenomeInfoDbData_1.2.0 IRanges_2.17.4         codetools_0.2-15
72  [31] crayon_1.3.4           dplyr_0.8.0.1          withr_2.1.2
73  [34] bitops_1.0-6           grid_3.6.0             nlme_3.1-137
74  [37] gtable_0.2.0           magrittr_1.5           scales_1.0.0
75  [40] KernSmooth_2.23-15     stringi_1.3.1          XVector_0.23.0
76  [43] sandwich_2.5-0         tools_3.6.0            glue_1.3.0
77  [46] purrr_0.3.0            colorspace_1.4-0       cluster_2.0.7-1
78  [49] GenomicRanges_1.35.1   caTools_1.17.1.1
79 !> 

Solution

  • You've come across one of the use-cases for why I built library(colourvalues) - to assign colours to values

    set.seed(81)
    
    ## random values that best replicate my data
    mm <- data.frame(VAR1 = abs(rnorm(n = 1655, 2, 100)), 
                     VAR2 = abs(rnorm(n = 1655, 2, 88)))
    
    library(colourvalues)
    
    mm$VAR1.color <- colour_values( mm$VAR1 )
    
    
    mm$h <- 10
    barplot( height = mm$h, col = mm$VAR1.color, border = NA, space = 0, yaxt = 'n')
    

    enter image description here

    mm <- mm[ with(mm, order(VAR1)), ]
    barplot( height = mm$h, col = mm$VAR1.color, border = NA, space = 0, yaxt = 'n')
    
    

    enter image description here