imcExperiment: containerization of IMC data

Anthony Colombo

18 August, 2021

Heatmap plotting script (helper)

example

 library(imcExperiment)
 showClass("imcExperiment")
## Class "imcExperiment" [package "imcExperiment"]
## 
## Slots:
##                                                                 
## Name:                   coordinates                cellIntensity
## Class:                       matrix                       matrix
##                                                                 
## Name:                  neighborHood                      network
## Class:                       matrix                   data.frame
##                                                                 
## Name:                      distance                   morphology
## Class:                       matrix                       matrix
##                                                                 
## Name:                   uniqueLabel          int_elementMetadata
## Class:                    character                    DataFrame
##                                                                 
## Name:                   int_colData                 int_metadata
## Class:                    DataFrame                         list
##                                                                 
## Name:                     rowRanges                      colData
## Class: GenomicRanges_OR_GRangesList                    DataFrame
##                                                                 
## Name:                        assays                        NAMES
## Class:               Assays_OR_NULL            character_OR_NULL
##                                                                 
## Name:               elementMetadata                     metadata
## Class:                    DataFrame                         list
## 
## Extends: 
## Class "SingleCellExperiment", directly
## Class "RangedSummarizedExperiment", by class "SingleCellExperiment", distance 2
## Class "SummarizedExperiment", by class "SingleCellExperiment", distance 3
## Class "RectangularData", by class "SingleCellExperiment", distance 4
## Class "Vector", by class "SingleCellExperiment", distance 4
## Class "Annotated", by class "SingleCellExperiment", distance 5
## Class "vector_OR_Vector", by class "SingleCellExperiment", distance 5
  #10 cells with 10 proteins
  # 10 neighbors 
 # and square distance matrix
 # note that for SCE objects the columns are the cells, and rows are proteins
  x<-imcExperiment(cellIntensity=matrix(1,nrow=10,ncol=10),
    coordinates=matrix(1,nrow=10,ncol=2),
    neighborHood=matrix(1,nrow=10,ncol=10),
    network=data.frame(matrix(1,nrow=10,ncol=10)),
    distance=matrix(1,nrow=10,ncol=10),
    morphology=matrix(1,nrow=10,ncol=10),
    uniqueLabel=paste0("A",seq_len(10)),
    panel=letters[1:10],
    ROIID=data.frame(ROIID=rep("A",10)))
  

 #7 cells with 10 proteins
 # but the spatial information is 10 rows and this will fail to build.
 #x<-imcExperiment(cellIntensity=matrix(1,nrow=7,ncol=10),
#   coordinates=matrix(1,nrow=10,ncol=2),
#   neighborHood=matrix(1,nrow=10,ncol=20),
#   network=matrix(1,nrow=10,ncol=3),
#   distance=matrix(1,nrow=10,ncol=2),
#   uniqueLabel=rep("A",10),
#   ROIID=data.frame(ROIID=rep("A",10)))

Accessors, and setters

  #get cellintensities
  cellIntensity(x)
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    1    1    1    1    1    1    1    1    1     1
##  [2,]    1    1    1    1    1    1    1    1    1     1
##  [3,]    1    1    1    1    1    1    1    1    1     1
##  [4,]    1    1    1    1    1    1    1    1    1     1
##  [5,]    1    1    1    1    1    1    1    1    1     1
##  [6,]    1    1    1    1    1    1    1    1    1     1
##  [7,]    1    1    1    1    1    1    1    1    1     1
##  [8,]    1    1    1    1    1    1    1    1    1     1
##  [9,]    1    1    1    1    1    1    1    1    1     1
## [10,]    1    1    1    1    1    1    1    1    1     1
  #set intensities
  newIn<-matrix(rnorm(100,2,5),nrow=10,ncol=10)
  rownames(newIn)<-rownames(x)
  colnames(newIn)<-colnames(x)
   cellIntensity(x)<-newIn
  cellIntensity(x)==newIn
##     A1   A2   A3   A4   A5   A6   A7   A8   A9  A10
## a TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## b TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## c TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## d TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## e TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## f TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## g TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## h TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## i TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## j TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
 # if we want to store both the raw and normalized values in assays we can.
  assays(x,withDimnames = FALSE)$raw<-matrix(1,nrow=10,ncol=10)
  #store the normalized values.
   cellIntensity(x)<-asinh(counts(x)/0.5)
   all(cellIntensity(x)==asinh(assays(x)$counts/0.5))
## [1] TRUE
  x
## class: imcExperiment 
## dim: 10 10 
## metadata(0):
## assays(2): counts raw
## rownames(10): a b ... i j
## rowData names(0):
## colnames(10): A1 A2 ... A9 A10
## colData names(1): ROIID
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):
 ## access the coordinates
  getCoordinates(x)
##       [,1] [,2]
##  [1,]    1    1
##  [2,]    1    1
##  [3,]    1    1
##  [4,]    1    1
##  [5,]    1    1
##  [6,]    1    1
##  [7,]    1    1
##  [8,]    1    1
##  [9,]    1    1
## [10,]    1    1
  getCoordinates(x)<-matrix(rnorm(20,0,10),nrow=10,ncol=2)
head(  getCoordinates(x))
##           [,1]        [,2]
## [1,]  1.138630   0.4920486
## [2,] -7.483197  14.0072048
## [3,] -2.995988   5.7263834
## [4,] -3.952030 -11.4399828
## [5,]  8.534859  -2.8095482
## [6,]  9.879779  19.3120798
 ## access the neighborhood profile.  Note each row must equal the number of cells, but the columns can be extended depending on the radius of interactions.
  ## access the coordinates
  getNeighborhood(x)
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    1    1    1    1    1    1    1    1    1     1
##  [2,]    1    1    1    1    1    1    1    1    1     1
##  [3,]    1    1    1    1    1    1    1    1    1     1
##  [4,]    1    1    1    1    1    1    1    1    1     1
##  [5,]    1    1    1    1    1    1    1    1    1     1
##  [6,]    1    1    1    1    1    1    1    1    1     1
##  [7,]    1    1    1    1    1    1    1    1    1     1
##  [8,]    1    1    1    1    1    1    1    1    1     1
##  [9,]    1    1    1    1    1    1    1    1    1     1
## [10,]    1    1    1    1    1    1    1    1    1     1
  getNeighborhood(x)<-matrix(rnorm(100,1,5),nrow=10,ncol=10)
 head( getNeighborhood(x))
##             [,1]      [,2]        [,3]      [,4]      [,5]      [,6]       [,7]
## [1,] -11.5292016  5.750663  5.32795370 -8.018236  1.701827 -5.041385  4.7460738
## [2,]  -1.1284688  5.185412 -0.12147623 -1.805766  4.498192  7.648025  0.6660934
## [3,]  -0.2312129  6.175255 -4.87813785 10.450752 -1.764999  1.617683 -0.3658961
## [4,]  -6.6399166 -7.081547  5.61946737  7.130634  4.629363  6.306020  4.5311604
## [5,]   7.9826941  6.890117  0.01332724  6.049404  1.661246 -2.705478 -7.2621050
## [6,]   3.4256881 -1.114269 -7.27957485  4.411063  2.104813 10.298950 -1.4588797
##            [,8]       [,9]      [,10]
## [1,]  1.4981864  8.2157026 -4.0862024
## [2,] -6.2570109  3.2871688 -6.7956895
## [3,] -1.6710766  4.0130912 -1.6708544
## [4,] -0.3772099 -1.6926917 -0.7368132
## [5,] -4.9718817 -4.1329155  4.3349482
## [6,]  7.8650851  0.8307328 -0.4697563
 ## get the distance usually a square matrix, or can be just first nearest etc. 
    getDistance(x)
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    1    1    1    1    1    1    1    1    1     1
##  [2,]    1    1    1    1    1    1    1    1    1     1
##  [3,]    1    1    1    1    1    1    1    1    1     1
##  [4,]    1    1    1    1    1    1    1    1    1     1
##  [5,]    1    1    1    1    1    1    1    1    1     1
##  [6,]    1    1    1    1    1    1    1    1    1     1
##  [7,]    1    1    1    1    1    1    1    1    1     1
##  [8,]    1    1    1    1    1    1    1    1    1     1
##  [9,]    1    1    1    1    1    1    1    1    1     1
## [10,]    1    1    1    1    1    1    1    1    1     1
  getDistance(x)<-matrix(rnorm(100,1,5),nrow=10,ncol=10)
  head(getDistance(x))
##            [,1]      [,2]       [,3]      [,4]       [,5]      [,6]       [,7]
## [1,] -4.4459580 0.3832962  1.2861954  5.191198  8.1144338  1.250347  3.5746833
## [2,]  2.2501458 8.5357020  6.0879762 -1.389698 -0.7572171  1.056745  3.4762454
## [3,]  1.8648350 7.6683573 -6.1207535  8.613386 -3.3720330 -1.958730  3.3212437
## [4,]  3.6676806 0.8794159  5.7258095 -3.174093  2.0034287  7.917606  3.1580990
## [5,] -0.1038772 3.1644572  0.1525853 -5.029461  6.0548022  3.773487 -8.7464480
## [6,]  3.9208435 8.4196328  2.5519046 -3.191540  8.7255777 -5.454160 -0.1319931
##           [,8]      [,9]       [,10]
## [1,] -1.414093 6.9717400   0.4301284
## [2,]  5.167939 4.3821819   4.1317587
## [3,]  8.287247 1.9860126 -10.6450490
## [4,] -4.710048 0.4533308   8.1478340
## [5,] -5.732384 3.8630923   5.3916885
## [6,] -4.847652 2.3099469   6.9436779
 # get morphological features
  getMorphology(x)
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
##  [1,]    1    1    1    1    1    1    1    1    1     1
##  [2,]    1    1    1    1    1    1    1    1    1     1
##  [3,]    1    1    1    1    1    1    1    1    1     1
##  [4,]    1    1    1    1    1    1    1    1    1     1
##  [5,]    1    1    1    1    1    1    1    1    1     1
##  [6,]    1    1    1    1    1    1    1    1    1     1
##  [7,]    1    1    1    1    1    1    1    1    1     1
##  [8,]    1    1    1    1    1    1    1    1    1     1
##  [9,]    1    1    1    1    1    1    1    1    1     1
## [10,]    1    1    1    1    1    1    1    1    1     1
  getMorphology(x)<-matrix(rnorm(100,1,5),nrow=10,ncol=60)
  head(getMorphology(x))
##            [,1]      [,2]       [,3]      [,4]       [,5]      [,6]       [,7]
## [1,] -0.2602892 -2.873465 -1.1884496 -8.110879  7.1433864 -3.124403  0.6445156
## [2,]  6.6712063  4.358327  0.8852602 -1.839347  4.7459084  2.049456  3.0144223
## [3,]  0.4508546  7.471209 -3.1749765 -4.185419  9.9250273  2.718686  4.2543621
## [4,]  5.3070444 -1.126719 -2.4471718 -6.437787  2.1392430  3.716662  9.4709743
## [5,]  0.2663402  1.076424 -2.7057904 -1.810752 -0.6675042  2.135795 -6.5746575
## [6,] -0.9224336 11.654316  2.2870520  4.787939  0.4979738 -4.675196 -6.1942677
##            [,8]       [,9]     [,10]      [,11]     [,12]      [,13]     [,14]
## [1,] -0.1020808  0.5043882 -2.792838 -0.2602892 -2.873465 -1.1884496 -8.110879
## [2,] -3.7028341  2.9473449 -1.527435  6.6712063  4.358327  0.8852602 -1.839347
## [3,]  2.5449114  1.8542034  2.661986  0.4508546  7.471209 -3.1749765 -4.185419
## [4,]  8.8134069  7.8361904  3.072036  5.3070444 -1.126719 -2.4471718 -6.437787
## [5,] 16.7918222 -1.0880037  3.122839  0.2663402  1.076424 -2.7057904 -1.810752
## [6,] -2.0700062 -1.1436743  3.858231 -0.9224336 11.654316  2.2870520  4.787939
##           [,15]     [,16]      [,17]      [,18]      [,19]     [,20]      [,21]
## [1,]  7.1433864 -3.124403  0.6445156 -0.1020808  0.5043882 -2.792838 -0.2602892
## [2,]  4.7459084  2.049456  3.0144223 -3.7028341  2.9473449 -1.527435  6.6712063
## [3,]  9.9250273  2.718686  4.2543621  2.5449114  1.8542034  2.661986  0.4508546
## [4,]  2.1392430  3.716662  9.4709743  8.8134069  7.8361904  3.072036  5.3070444
## [5,] -0.6675042  2.135795 -6.5746575 16.7918222 -1.0880037  3.122839  0.2663402
## [6,]  0.4979738 -4.675196 -6.1942677 -2.0700062 -1.1436743  3.858231 -0.9224336
##          [,22]      [,23]     [,24]      [,25]     [,26]      [,27]      [,28]
## [1,] -2.873465 -1.1884496 -8.110879  7.1433864 -3.124403  0.6445156 -0.1020808
## [2,]  4.358327  0.8852602 -1.839347  4.7459084  2.049456  3.0144223 -3.7028341
## [3,]  7.471209 -3.1749765 -4.185419  9.9250273  2.718686  4.2543621  2.5449114
## [4,] -1.126719 -2.4471718 -6.437787  2.1392430  3.716662  9.4709743  8.8134069
## [5,]  1.076424 -2.7057904 -1.810752 -0.6675042  2.135795 -6.5746575 16.7918222
## [6,] 11.654316  2.2870520  4.787939  0.4979738 -4.675196 -6.1942677 -2.0700062
##           [,29]     [,30]      [,31]     [,32]      [,33]     [,34]      [,35]
## [1,]  0.5043882 -2.792838 -0.2602892 -2.873465 -1.1884496 -8.110879  7.1433864
## [2,]  2.9473449 -1.527435  6.6712063  4.358327  0.8852602 -1.839347  4.7459084
## [3,]  1.8542034  2.661986  0.4508546  7.471209 -3.1749765 -4.185419  9.9250273
## [4,]  7.8361904  3.072036  5.3070444 -1.126719 -2.4471718 -6.437787  2.1392430
## [5,] -1.0880037  3.122839  0.2663402  1.076424 -2.7057904 -1.810752 -0.6675042
## [6,] -1.1436743  3.858231 -0.9224336 11.654316  2.2870520  4.787939  0.4979738
##          [,36]      [,37]      [,38]      [,39]     [,40]      [,41]     [,42]
## [1,] -3.124403  0.6445156 -0.1020808  0.5043882 -2.792838 -0.2602892 -2.873465
## [2,]  2.049456  3.0144223 -3.7028341  2.9473449 -1.527435  6.6712063  4.358327
## [3,]  2.718686  4.2543621  2.5449114  1.8542034  2.661986  0.4508546  7.471209
## [4,]  3.716662  9.4709743  8.8134069  7.8361904  3.072036  5.3070444 -1.126719
## [5,]  2.135795 -6.5746575 16.7918222 -1.0880037  3.122839  0.2663402  1.076424
## [6,] -4.675196 -6.1942677 -2.0700062 -1.1436743  3.858231 -0.9224336 11.654316
##           [,43]     [,44]      [,45]     [,46]      [,47]      [,48]      [,49]
## [1,] -1.1884496 -8.110879  7.1433864 -3.124403  0.6445156 -0.1020808  0.5043882
## [2,]  0.8852602 -1.839347  4.7459084  2.049456  3.0144223 -3.7028341  2.9473449
## [3,] -3.1749765 -4.185419  9.9250273  2.718686  4.2543621  2.5449114  1.8542034
## [4,] -2.4471718 -6.437787  2.1392430  3.716662  9.4709743  8.8134069  7.8361904
## [5,] -2.7057904 -1.810752 -0.6675042  2.135795 -6.5746575 16.7918222 -1.0880037
## [6,]  2.2870520  4.787939  0.4979738 -4.675196 -6.1942677 -2.0700062 -1.1436743
##          [,50]      [,51]     [,52]      [,53]     [,54]      [,55]     [,56]
## [1,] -2.792838 -0.2602892 -2.873465 -1.1884496 -8.110879  7.1433864 -3.124403
## [2,] -1.527435  6.6712063  4.358327  0.8852602 -1.839347  4.7459084  2.049456
## [3,]  2.661986  0.4508546  7.471209 -3.1749765 -4.185419  9.9250273  2.718686
## [4,]  3.072036  5.3070444 -1.126719 -2.4471718 -6.437787  2.1392430  3.716662
## [5,]  3.122839  0.2663402  1.076424 -2.7057904 -1.810752 -0.6675042  2.135795
## [6,]  3.858231 -0.9224336 11.654316  2.2870520  4.787939  0.4979738 -4.675196
##           [,57]      [,58]      [,59]     [,60]
## [1,]  0.6445156 -0.1020808  0.5043882 -2.792838
## [2,]  3.0144223 -3.7028341  2.9473449 -1.527435
## [3,]  4.2543621  2.5449114  1.8542034  2.661986
## [4,]  9.4709743  8.8134069  7.8361904  3.072036
## [5,] -6.5746575 16.7918222 -1.0880037  3.122839
## [6,] -6.1942677 -2.0700062 -1.1436743  3.858231
 ## for each cell we can obtain the ROI that it belongs to
  rowData(x)
## DataFrame with 10 rows and 0 columns
 ## if we want to add patient features to each ROI we can
  metas<-data.frame(ROIID=factor(rep("A",10)),treatment=factor(rep('none',10)))
  colData(x)<-DataFrame(metas)

 ##other slots for covariates
   metadata(x)$experiment<-'test'
   metadata(x)
## $experiment
## [1] "test"

From histoCAT to R

  ### load the data from package.
  library(imcExperiment)
 ##load the data 1000 cells from IMC experiment.
  data(data)
  dim(data)
## [1] 1000   62
  ##output from histoCAT to R
  expr<-data[,3:36]
  normExp<-percentilenormalize(data=expr,percentile=0.99)
  normExp<-as.matrix(normExp)


  ##spatial component
  spatial<-(data[,c("X_position","Y_position")])
  spatial<-as.matrix(spatial)
 ##uniqueLabel
  uniqueLabel<-paste0(data[,"ImageId"],"_",data[,"CellId"])

 phenotypes<-data[,grepl("Phenograph",colnames(data))]
 morph<-as.matrix(data[,c("Area","Eccentricity",
    "Solidity",
    "Extent",
    "Perimeter")])

  x<-imcExperiment(cellIntensity=t(normExp),
    coordinates=spatial,
    neighborHood=as.matrix(data[,grepl("neighbour_",colnames(data))]),
    network=phenotypes,
    distance=matrix(1,nrow=nrow(data),ncol=10),
    morphology=morph,
    panel=colnames(normExp),
    uniqueLabel=paste0(data$ImageId,"_",data$CellId),
    ROIID=data.frame(ROIID=data$ImageId))

 ## explore the container.
  dim(assay(x))
## [1]   34 1000
   colData(x)$treatment<-DataFrame(treatment=rep('none',1000))
   head(colData(x))
## DataFrame with 6 rows and 2 columns
##              ROIID   treatment
##          <integer> <DataFrame>
## 274864_1    274864        none
## 274864_2    274864        none
## 274864_3    274864        none
## 274864_4    274864        none
## 274864_5    274864        none
## 274864_6    274864        none
 head( colnames(x))
## [1] "274864_1" "274864_2" "274864_3" "274864_4" "274864_5" "274864_6"
  rownames(x)
##  [1] "marker1"  "marker2"  "marker3"  "marker4"  "marker5"  "marker6" 
##  [7] "marker7"  "marker8"  "marker9"  "marker10" "marker11" "marker12"
## [13] "marker13" "marker14" "marker15" "marker16" "marker17" "marker18"
## [19] "marker19" "marker20" "marker21" "marker22" "marker23" "marker24"
## [25] "marker25" "marker26" "marker27" "marker28" "marker29" "marker30"
## [31] "marker31" "marker32" "marker33" "marker34"
  ## Intensity
  all(t(cellIntensity(x))==normExp)
## [1] TRUE
  head(t(cellIntensity(x)))
##     marker1   marker2   marker3   marker4   marker5    marker6   marker7
## 1 0.4656571 0.2736824 0.7237669 0.5204605 0.6330375 0.45935533 0.2857143
## 2 0.3487101 0.2897530 0.3958101 0.3548617 0.5588399 0.11483883 0.5000000
## 3 0.8883986 0.7622286 0.8866145 0.4873408 0.2400462 0.18374213 0.0000000
## 4 0.3963552 0.1451175 0.2714126 1.0000000 0.2100260 0.19686657 0.0000000
## 5 0.5407341 0.2522549 0.4221974 0.1064634 0.8991254 0.07655922 0.3333333
## 6 1.0000000 0.7622286 0.0000000 0.7854187 0.2018387 0.82683960 0.8000000
##     marker8   marker9  marker10   marker11  marker12   marker13  marker14
## 1 0.4237137 0.1981346 0.5895631 0.38423632 0.5596034 1.00000000 0.5421737
## 2 0.2118568 0.1812504 0.3699262 0.04531335 0.1284526 0.04016094 0.1667561
## 3 0.4237137 0.6934055 0.2150245 0.69305332 1.0000000 0.11646341 0.4103197
## 4 0.7263663 0.3632249 0.1866203 1.00000000 0.9999276 0.02467097 0.9450608
## 5 0.3530947 0.1155895 0.8496593 0.55169689 0.1819642 0.06291782 0.1453909
## 6 0.2542282 0.2731756 0.4462211 0.21726828 0.6036358 0.05220870 0.1539370
##     marker15  marker16  marker17  marker18   marker19  marker20  marker21
## 1 0.46990599 0.0952381 0.4987356 0.5269829 0.04774145 0.5735263 0.7197223
## 2 0.15883470 0.1666667 0.4851215 0.4321421 0.34528973 0.3484509 0.4443348
## 3 0.45147213 0.2666667 0.6154904 0.6206074 0.30741995 0.5060037 0.8448015
## 4 0.07050581 0.5714286 0.4715074 0.4803021 0.04774145 0.4609886 0.1938211
## 5 0.60815990 0.3333333 0.3834694 0.3128651 0.12438267 0.2171569 0.4567717
## 6 0.58665373 0.4000000 1.0000000 1.0000000 0.08020126 0.6635565 0.4070243
##    marker22  marker23   marker24  marker25   marker26  marker27  marker28
## 1 0.4735184 0.9999835 0.12229278 0.2651672 0.19823739 1.0000000 0.2379700
## 2 0.3429377 0.4963629 0.08592210 0.3093618 0.06938309 0.1036510 0.2082237
## 3 0.4343442 0.6072488 0.40161962 0.3093618 0.11101294 1.0000000 0.6663160
## 4 0.4735184 0.8192498 0.04747309 0.0000000 0.23788486 0.9639418 0.0000000
## 5 0.4191098 0.3712448 0.22898012 0.3609221 0.00000000 0.4915438 0.2776317
## 6 0.7085638 0.1612178 0.33178791 0.0000000 0.49955821 1.0000000 0.0000000
##    marker29  marker30  marker31   marker32   marker33  marker34
## 1 0.5826594 0.4963881 0.4285714 0.57132469 0.32432082 0.7448313
## 2 0.1140364 0.3285300 0.1250000 0.53626613 0.44897580 0.2375474
## 3 0.9637037 0.6810320 0.5000000 0.37811307 0.02758118 0.5500343
## 4 1.0000000 0.8740688 0.8571429 0.13504038 0.07298397 0.9535425
## 5 0.4187694 0.6712403 0.3333333 0.07271405 0.44188161 0.2307836
## 6 0.3614079 0.9747837 0.3000000 1.00000000 0.54971323 0.5500343
  ##coordinate
  all(getCoordinates(x)==spatial)
## [1] TRUE
  head(getCoordinates(x))
##   X_position Y_position
## 1   508.0000   3.000000
## 2   672.1667   3.000000
## 3   154.2000   4.200000
## 4   538.5714   4.857143
## 5   913.2778   3.444444
## 6  1200.0000   4.200000
  #neighbor attraction data form histoCAT
 all(getNeighborhood(x)==as.matrix(data[,grepl("neighbour_",colnames(data))]))
## [1] TRUE
 head(getNeighborhood((x)))
##   neighbour_4_CellId1 neighbour_4_CellId2 neighbour_4_CellId3
## 1                  36                 168                   0
## 2                 144                   0                   0
## 3                   0                   0                   0
## 4                  67                  92                   0
## 5                  13                  97                 249
## 6                 135                   0                   0
##   neighbour_4_CellId4 neighbour_4_CellId5 neighbour_4_CellId6
## 1                   0                   0                   0
## 2                   0                   0                   0
## 3                   0                   0                   0
## 4                   0                   0                   0
## 5                   0                   0                   0
## 6                   0                   0                   0
##   neighbour_4_CellId7 neighbour_4_CellId8 neighbour_4_CellId9
## 1                   0                   0                   0
## 2                   0                   0                   0
## 3                   0                   0                   0
## 4                   0                   0                   0
## 5                   0                   0                   0
## 6                   0                   0                   0
##   neighbour_4_CellId10
## 1                    0
## 2                    0
## 3                    0
## 4                    0
## 5                    0
## 6                    0
 ##phenotype cluster ID
  head(getNetwork(x))
##   (network)
## 1         1
## 2         1
## 3         4
## 4         4
## 5         1
## 6         1
 all(getNetwork(x)==phenotypes)
## [1] TRUE
 ###distance calculations
  head(getDistance(x))
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,]    1    1    1    1    1    1    1    1    1     1
## [2,]    1    1    1    1    1    1    1    1    1     1
## [3,]    1    1    1    1    1    1    1    1    1     1
## [4,]    1    1    1    1    1    1    1    1    1     1
## [5,]    1    1    1    1    1    1    1    1    1     1
## [6,]    1    1    1    1    1    1    1    1    1     1
  ##morphology
   all(getMorphology(x)==morph)
## [1] TRUE
  head(getMorphology(x))
##   Area Eccentricity  Solidity    Extent Perimeter
## 1   21    0.6956573 0.9545455 0.8400000    13.844
## 2   24    0.8034622 0.9230769 0.6666667    16.565
## 3   15    0.9014174 1.0000000 0.7142857    12.918
## 4    7    0.8717717 0.8750000 0.5833333     7.683
## 5   18    0.9593719 0.7500000 0.3214286    19.766
## 6    5    0.7437865 1.0000000 0.5555556     5.814
  ##uniqueLabel
   head(getLabel(x))
## [1] "274864_1" "274864_2" "274864_3" "274864_4" "274864_5" "274864_6"
   all(getLabel(x)==paste0(data$ImageId,"_",data$CellId) )
## [1] TRUE

PCA demo analysis

 ### inherited accessor.
  pca_data <- prcomp(t(counts(x)), rank=50)
tsDat<-data.frame(tsne.x=data$tSNE4148542692_1,tsne.y=data$tSNE4148542692_2,row.names=colnames(x))

reducedDims(x)<-list(PCA=pca_data$x,TSNE=tsDat)
x
## class: imcExperiment 
## dim: 34 1000 
## metadata(0):
## assays(1): counts
## rownames(34): marker1 marker2 ... marker33 marker34
## rowData names(0):
## colnames(1000): 274864_1 274864_2 ... 274864_999 274864_1000
## colData names(2): ROIID treatment
## reducedDimNames(2): PCA TSNE
## mainExpName: NULL
## altExpNames(0):
reducedDimNames(x)
## [1] "PCA"  "TSNE"
     dim(reducedDims(x)$PCA)
## [1] 1000   34
     dim(reducedDims(x)$TSNE)
## [1] 1000    2
 imc<-x
 x<-NULL

IMC container and Phenograph cluster neighborhood

 ### create  phenotypes via Rphenograph
  ##run phenograph
  library(Rphenograph)
library(igraph)
  phenos<-Rphenograph(t(cellIntensity(imc)),k=35)
   pheno.labels<-as.numeric(igraph::membership(phenos[[2]]))
   getNetwork(imc)<-data.frame(cell_clustering=pheno.labels)
   head( getNetwork(imc))
  ##plot phenograph
  #plot_clustering_heatmap_wrapper(myExperiment=imc)

histoCAT analysis

### reading in a directory of histoCAT csv files.

 ##need to reconstruct the fold revised IMC data.
  ##merges a folder full of histoCAT csv files.
 # use morphology and the 1-10 neighbors.
  dataSet<-NULL
 for(i in c("case8.csv","case5.csv")){
  message(i)
    fpath <- system.file("extdata", i, package="imcExperiment")
    case1<-read.csv(fpath)
   proteins<-colnames(case1)[grepl("Cell_",colnames(case1))]
   neig<-colnames(case1)[grepl("neighbour_",colnames(case1))][1:10]
    case1<-case1[,c("ImageId","CellId","X_position","Y_position",proteins,
                    "Area",
                    "Eccentricity",
    "Solidity",
    "Extent",
    "Perimeter",
     neig)]
    dataSet<-rbind(dataSet,case1)
  }
## case8.csv
## case5.csv
 expr<-dataSet[,proteins]
  normExp<-percentilenormalize(data=expr,percentile=0.99)
  normExp<-as.matrix(normExp)
  boxplot(normExp)

  ##spatial component
  spatial<-(dataSet[,c("X_position","Y_position")])
  spatial<-as.matrix(spatial)
 ##uniqueLabel
  uniqueLabel<-paste0(dataSet[,"ImageId"],"_",dataSet[,"CellId"])

  ##not yet assigned
  phenotypes<-matrix(0,nrow(dataSet),1)
  ROIID=data.frame(ROIID=dataSet[,"ImageId"])
  morph<-dataSet[,c("Area",
                    "Eccentricity",
    "Solidity",
    "Extent",
    "Perimeter")]
  
  x<-imcExperiment(cellIntensity=t(normExp),
    coordinates=spatial,
    neighborHood=as.matrix(dataSet[,grepl("neighbour_",colnames(dataSet))]),
    network=phenotypes,
    distance=matrix(1,nrow=nrow(dataSet),ncol=10),
    morphology=morph,
    panel=colnames(normExp),
    uniqueLabel=uniqueLabel,
    ROIID=ROIID)
   x
## class: imcExperiment 
## dim: 34 2000 
## metadata(0):
## assays(1): counts
## rownames(34): Cell_CCR4Sm149Di_Sm149 Cell_CD15Dy164Di_Dy164 ...
##   Cell_VimentinNd143Di_Nd143 Cell_pStat3Gd158Di_Gd158
## rowData names(0):
## colnames(2000): 372149_1 372149_2 ... 274864_999 274864_1000
## colData names(1): ROIID
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):
   #require(Rphenograph); library(igraph)
  #phenos<-Rphenograph(t(cellIntensity(x)),k=35)
  # pheno.labels<-as.numeric(membership(phenos[[2]]))
  # getNetwork(x)<-data.frame(cell_clustering=pheno.labels)
  #  head(getNetwork(x))
 ##plot phenograph
  #plot_clustering_heatmap_wrapper(myExperiment=x)

Access unique cell ID

 ##store the ROIID in the metadata columns.
  ##access the unique cell labels.

  tail(getLabel(x))
## [1] "274864_995"  "274864_996"  "274864_997"  "274864_998"  "274864_999" 
## [6] "274864_1000"
  roi<-subsetCase(x,372149 )
  roi
## class: imcExperiment 
## dim: 34 1000 
## metadata(0):
## assays(1): counts
## rownames(34): Cell_CCR4Sm149Di_Sm149 Cell_CD15Dy164Di_Dy164 ...
##   Cell_VimentinNd143Di_Nd143 Cell_pStat3Gd158Di_Gd158
## rowData names(0):
## colnames(1000): 372149_1 372149_2 ... 372149_999 372149_1000
## colData names(1): ROIID
## reducedDimNames(0):
## mainExpName: NULL
## altExpNames(0):
  table(sapply(strsplit(getLabel(roi),"_"),function(x) x[1]))
## 
## 372149 
##   1000

Distance computations speedily

  ##you can append more clinical features to the columns of the sampleDat data.frame.
  H<-imcExperimentToHyperFrame(imcExperiment=x,phenotypeToUse = 1)
  helper<-function(pp=NULL,i=NULL,j=NULL){
  ps<-split(pp)
  nnd<-nncross(ps[[i]],ps[[j]])
  }
 ## 1-NN analysis.
  ## compare cluster 10 to cluster 9
   #eachNND<-with(H,helper(pp=point,i="10",j="8"))
 ## first choose 2 clusters to compare.
 # sapply(eachNND,function(x) mean(x[,"dist"]))

Changing class from IMC to SummarizedExperiment

  • IMC container can change to SummarizedExperiment and the FlowSOM algorithm can be used for cell classification.
  library(CATALYST)
library(cowplot)
library(flowCore)
library(ggplot2)
library(SingleCellExperiment)
library(diffcyt)

 ## from IMCexperiment to SCE
 sce<- SingleCellExperiment(x)
 class(sce)

 ## FIX ME: add the SOM algorithms for over-clustering and meta-clustering by using class inheritance. 

 #### for the cytof, the columns are sample info and the rows are cells. it uses the SummarizedExperiment format.
 
 

 ## change into a flowFrame?

 ## change into a daFrame (CATALYST)

 #data("data")

 
 rd<-DataFrame(colData(imcdata))

  marker_info<-data.frame(channel_name=sapply(strsplit(rownames(imcdata),"_"),function(x) x[3]),
              marker_name=rownames(imcdata),
              marker_class=c(rep("type",13),
                             rep("state",18),
                             rep("none",13)))

  ## Switching into Summarized Experiment class.
    dse<-SummarizedExperiment(assays=SimpleList(exprs=t(cellIntensity(imcdata))),
                           rowData=rd,
                           colData=DataFrame(marker_info)
                           )
   stopifnot(all(colnames(dse)==marker_info$marker_name))
   dse

 # Transform data recommended
 dse <- transformData(dse)
## maybe look a the normalization.
# Generate clusters
dse <- (generateClusters(dse,meta_clustering=TRUE,meta_k=30,seed_clustering=828))

 ## examine each cluster.
cluster<-rowData(dse)
 data<-data.frame(t(logcounts(imcdata)),cluster)
 #plot_matrix_heatmap_wrapper(expr=data[,rownames(imcdata)],
  #                               cell_clustering=data$cluster_id)
 #

IMC and flowSet conversions

   ## the assay returns matrix class! required for CATALYST.
  is(assay(imcdata,'counts'),'matrix')
  rownames(imcdata)
    # for plot scatter to work need to set the rowData feature in a specific way.
   channel<-sapply(strsplit(rownames(imcdata),"_"),function(x) x[3])
      channel[34:35]<-c("Ir1911","Ir1931")

   marker<-sapply(strsplit(rownames(imcdata),"_"),function(x) x[2])
    rowData(imcdata)<-DataFrame(channel_name=channel,marker_name=marker)
      rownames(imcdata)<-marker
            plotScatter(imcdata,rownames(imcdata)[17:18],assay='counts')

  # convert to flowSet
             ## the warning has to do with duplicated Iridium channels.
   table(colData(imcdata)$ROIID)
       (fsimc <- sce2fcs(imcdata, split_by = "ROIID"))
    ## now we have a flowSet.
   pData(fsimc)
   fsApply(fsimc,nrow)
   dim(exprs(fsimc[[1]]))
   exprs(fsimc[[1]])[1:5,1:5]
    ## set up the metadata files.
   head(marker_info)
   
    exper_info<-data.frame(group_id=colData(imcdata)$Treatment[match(pData(fsimc)$name,colData(imcdata)$ROIID)],
                           patient_id=colData(imcdata)$Patient.Number[match(pData(fsimc)$name,colData(imcdata)$ROIID)],
                           sample_id=pData(fsimc)$name)
   
   ## create design
   design<-createDesignMatrix(
     exper_info,cols_design=c("group_id","patient_id"))
   
   ##set up contrast 
   contrast<-createContrast(c(0,1,0))
   nrow(contrast)==ncol(design)
   data.frame(parameters=colnames(design),contrast)
   
    ## flowSet to DiffCyt
    out_DA<-diffcyt(
      d_input=fsimc,
      experiment_info=exper_info,
      marker_info=marker_info,
      design=design,
      contrast=contrast,
      analysis_type = "DA",
      seed_clustering = 123
    )
   topTable(out_DA,format_vals = TRUE)
   
   out_DS<-diffcyt(
     d_input=fsimc,
     experiment_info=exper_info,
     marker_info=marker_info,
     design=design,
     contrast=contrast,
     analysis_type='DS',
     seed_clustering = 123,
     plot=FALSE)
   
      topTable(out_DS,format_vals = TRUE)
      
       ### from flowSet to SE.
 d_se<-prepareData(fsimc,exper_info,marker_info)

Diffcyt package tutorial (extra)

  • Given a flowSet object we can utilize the diffCyt package for measuring phenotype differences.
  • This code section is an example of diffcyt from their manual.
  • Creates a random summarized experiment.
 library(diffcyt)
# Function to create random data (one sample)
d_random <- function(n = 20000, mean = 0, sd = 1, ncol = 20, cofactor = 5) {
  d <- sinh(matrix(rnorm(n, mean, sd), ncol = ncol)) * cofactor
  colnames(d) <- paste0("marker", sprintf("%02d", 1:ncol))
  d
}
# Create random data (without differential signal)
set.seed(123)
d_input <- list(
  sample1 = d_random(), 
  sample2 = d_random(), 
  sample3 = d_random(), 
  sample4 = d_random()
)
experiment_info <- data.frame(
  sample_id = factor(paste0("sample", 1:4)), 
  group_id = factor(c("group1", "group1", "group2", "group2")), 
  stringsAsFactors = FALSE
)
marker_info <- data.frame(
  channel_name = paste0("channel", sprintf("%03d", 1:20)), 
  marker_name = paste0("marker", sprintf("%02d", 1:20)), 
  marker_class = factor(c(rep("type", 10), rep("state", 10)), 
                        levels = c("type", "state", "none")), 
  stringsAsFactors = FALSE
)
# Prepare data
d_se <- prepareData(d_input, experiment_info, marker_info)
# Transform data
d_se <- transformData(d_se)
# Generate clusters
d_se <- generateClusters(d_se)