Los datos que utilizaremos vienen de un estudio de Chiaretti et al. sobre la leucemia linfoblastica aguda (ALL), la cual fue conducida con chips de microarreglos HG-U95Av2 de Aymetrix. El paquete de datos ALL contiene los datos de expresion del experimento, normalizados con rma (las intensidades estan en escala log2), junto con las anotaciones de las muestras.

Para ello utilizaremos R /Bioconductor Si no has instalado Bioconductor previemente necesitas correr las siguientes líneas

source("http://bioconductor.org/biocLite.R")
biocLite()

Necesitaremos instalar algunas librerías de Bioconductor

biocLite(c("affy","ALL","annotate","hgu95av2.db","multtest","topGO","genefilter"))

Ahora, cargamos los datos de microarreglos y los asociamos a un set de expresión con

library(ALL)
data(ALL)

Y para conocer la dimensión de la matriz de expresión

dim(exprs(ALL))

[1] 12625 128

Por tanto, se trata de 128 columnas (muestras) con 12,625 filas (sondas) Nos interesa seleccionar todas las sondas de las células B (que pueden ser identicadas por la columna BT del ExpressionSet ALL).

table(ALL$BT)
B B1 B2 B3 B4  T T1 T2 T3 T4 
5 19 36 23 12  5  1 15 10  2

Ademas nos interesa la comparacion de las sondas con la fusión del gen BCR/ABL resultante de la traslocacion de los cromosomas 9 y 22

table(ALL$mol.biol)
ALL1/AF4  BCR/ABL E2A/PBX1      NEG   NUP-98  p15/p16 
      10       37        5       74        1        1 

Para seleccionar todos los genes de las células B con la fusión BCR/ABL y del grupo control

subset <- intersect(grep("^B", as.character(ALL$BT)),
                    which(as.character(ALL$mol.biol)
                          %in% c("BCR/ABL", "NEG")))

Y creamos un nuevo set de expresión con los genes seleccionados previamente

eset <- ALL[, subset]

Para poder comparar el grupo de los pacientes control con los que presentan la fusión BCR/ABL, necesitamos convertir a factores la columna eset$mol.biol

eset$mol.biol <- factor(eset$mol.biol)
table(eset$mol.biol)
BCR/ABL     NEG 
     37      42

Muchos de los genes en el chip no se expresan en las celulas B estudiados aquí, o podrían solo tener una pequeña variabilidad a traves de las sondas. Trataremos de remover esos genes con un filtro de intensidad (la intensidad de un gen debe de estar arriba de 100 y en al menos el 25 porciento de las sondas); y un filtro de varianza (el rango intercuartil de las intensidades log2 debera ser al menos de 0.5)

library(genefilter)
f1 <- pOverA(0.25, log2(100))
f2 <- function(x) (IQR(x) > 0.5)
ff <- filterfun(f1, f2)

Cuantos genes podemos obtener despues del filtrado?

selected <- genefilter(eset, ff)
sum(selected)

[1] 2391

Crearemos un nuevo ExpressionSet que contenga solo los genes que pasaron nuestro filtro.

esetSub <- eset[selected, ]

Ahora estamos listos para analizar la expresion diferencial en los genes seleccionados entre las muetraas BRC/ABL y la normales citogenéticamente. Utilizaremos una prueba t pareada, para identicar los genes expresados de manera diferencial entre los dos grupos.

library(multtest)

La funcion mt.teststat del paquete multtest nos permite calcular varios estadsticos de prueba comunmente usados para todas las las de una matriz de datos (chequen su pagina de ayuda). Primero, calcularemos los p-values nominales

library(multtest)
cl <- as.numeric(esetSub$mol.biol == "BCR/ABL")
t <- mt.teststat(
exprs(esetSub),
classlabel = cl,
test = "t.equalvar")

La funcion pt nos da la distribucion t.

pt <- 2 * pt(-abs(t), df = ncol(exprs(esetSub)))

Podemos obtener una impresion de la cantidad de genes expresados de manera diferencial, observando en un histograma de la distribucion del valor de p.

hist(pt, 50)

La función mt.rawp2adjp de el paquete multtest contiene distintos procedimeintos de prueba (Checa la página de ayuda para esta función). Para obtener el ajuste de p-value en términos de FDR (False Discovery Rate) utilizaremos el método de Benjamini y Hochberg. ¿Cuántos genes obtendremos si imponemos un FDR de 0.1?

pAdjusted <- mt.rawp2adjp(pt, proc = c("BH"))
sum(pAdjusted$adjp[, "BH"] < 0.1)

[1] 171

También esta función retorna los p-values ordenados de menor a mayor. Para obtenerlos ordenados utilizaremos:

pBH <- pAdjusted$adjp[order(pAdjusted$index), "BH"]
names(pBH)<-featureNames(esetSub)

Ahora, queremos conocer cuáles genes son los más significativos, por medio de el análisis de sus valores crudos (raw) y sus p-values ajustados por distintos métodos. Los símbolos de los genes son obtenidos por medio del paquete de anotación hgu95av2.

library(annotate)
library(hgu95av2.db)
diff <- pAdjusted$index[1:10]
genesymbolsDiff <- unlist(mget(featureNames(esetSub)[diff], hgu95av2SYMBOL))
genesymbolsDiff
 1636_g_at   39730_at    1635_at   40202_at   37027_at 39837_s_at 
    "ABL1"     "ABL1"     "ABL1"     "KLF9"    "AHNAK"   "ZNF467" 
40480_s_at   33774_at   36591_at   37014_at 
     "FYN"    "CASP8"   "TUBA4A"      "MX1" 

El top 3 de las sondas representan al gen ABL1, el cual es afectado, por la traslocación caracterizada por mas sondas BCR/ABL. Ahora queremos ver si existen otro conjunto de sondas que representen a este gen, y ver éste ha sido seleccionado por nuestro filtro no específico.

geneSymbols = unlist(mget(featureNames(ALL), hgu95av2SYMBOL))
ABL1probes <- which(geneSymbols == "ABL1")
selected[ABL1probes]
  1635_at 1636_g_at 1656_s_at 2040_s_at 2041_i_at  39730_at 
     TRUE      TRUE     FALSE     FALSE     FALSE      TRUE

Así que los otros conjuntos de sondas en el chip representando ABL1 han sido eliminados por el filtro, debido a baja intensidad o baja varianza. Ahora queremos saber si esto indica también expresión diferencial del gen ALB1.

tABL1 <- mt.teststat(exprs(eset)[ABL1probes, ], classlabel = cl,
test = "t.equalvar")
ptABL1 <- 2 * pt(-abs(tABL1), df = ncol(exprs(esetSub)) - 2)
sort(ptABL1)
[1] 3.762489e-14 4.791997e-13 2.445693e-10 5.486259e-02 5.842693e-01
[6] 7.570959e-01

Vemos ahora que solo tres de las seis sondas para ABL1 muestran evidencia (de hecho, evidencia muy fuerte) para expresión diferencial. Seria interesante seguir investigando si el conjunto de sondas, en lo que concierne pe. a su localización en la secuencia del transcripto ABL1 - en efecto la fusión de genes BCR/ABL resulta de la traslocación del gen normal ABL1. Utilizando la ontología de genes Muchos de los efectos debidos a la traslocación BCR/ABL, son mediados por la actividad de tirosina cinasa. Veamos ahora los conjuntos de sondas en el chip que pertenecen a el término GO de actividad proteína tirosina cinasa, la cuál tiene el identificador GO:0004713.

gN <- featureNames(esetSub)
tykin <- unique(unlist(lookUp("GO:0004713",
"hgu95av2", "GO2ALLPROBES")))
str(tykin)
sel <- (gN %in% tykin)

Ahora podermos checar si los genes entre las tirisina cinasas son expresados de manera diferencial, respecto a los otros genes. Utilizaremos una prueba exacta de Fisher, para tablas de contingencias, para revisar las proporciones de los genes expresados diferencialmente son significativas entre dos grupos de genes.

tab <- table(pt < 0.05, sel, dnn = c("p < 0.05", "tykin"))
print(tab)
        tykin
p < 0.05 FALSE TRUE
   FALSE  1914   26
   TRUE    434   17
fisher.test(tab)
	Fisher's Exact Test for Count Data

data:  tab
p-value = 0.001297
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
 1.453631 5.573555
sample estimates:
odds ratio 
  2.881814 

Análisis para el enriquecimiento de conjunto de genes. Ahora queremos buscar el enriquecimiento en la expresión diferencial en todas las categorías GO, no solo para la actividad de tirosina cinasa. Utilizaremos el paquete TopGO para este fin. Y necesitaremos definir una función que seleccione los genes expresados de manera diferencial.

library(topGO) #load the package
topDiffGenes <- function(allScore) return(allScore < 0.05)

Ahora estamos listos para hecer un nuevo objeto topGO. Buscaremos en las ontologías en el nivel de función molecular MF.

GOdataMF <- new("topGOdata", ontology = "MF",
allGenes = pBH, geneSel = topDiffGenes, annot = annFUN.db,
affyLib = "hgu95av2.db")

Ahora podremos correr una prueba de fisher, para todos los procesos biológicos o utilizar algunos otros métodos (Bioinformatics, 2006, 22(13):1600-1607)

resultFisher <- runTest(GOdataMF, algorithm = "classic", statistic = "fisher")
resultKS<- runTest(GOdataMF, algorithm = "classic", statistic = "ks")
resultFisher.elim<- runTest(GOdataMF, algorithm = "elim", statistic = "fisher")
resultKS.elim<- runTest(GOdataMF, algorithm = "elim", statistic = "ks")

Para mostrar los resultados

allRes <- GenTable(GOdataMF, classicFisher = resultFisher,
classicKS = resultKS,elimFisher = resultFisher.elim, elimKS = resultKS.elim,
orderBy = "elimKS", ranksOf = "classicFisher", topNodes = 20)
allRes
        GO.ID                                        Term Annotated
1  GO:0005509                         calcium ion binding        78
2  GO:0004714 transmembrane receptor protein tyrosine ...         7
3  GO:0003785                       actin monomer binding         3
4  GO:0004515 nicotinate-nucleotide adenylyltransferas...         3
5  GO:0051019    mitogen-activated protein kinase binding        10
6  GO:0004871                  signal transducer activity       188
7  GO:0042379                  chemokine receptor binding        10
8  GO:0038023                 signaling receptor activity        91
9  GO:0005516                          calmodulin binding        25
10 GO:0008201                             heparin binding        16
11 GO:0005088 Ras guanyl-nucleotide exchange factor ac...        26
12 GO:0015276           ligand-gated ion channel activity         9
13 GO:0005520          insulin-like growth factor binding         4
14 GO:0031730             CCR5 chemokine receptor binding         8
15 GO:0048020              CCR chemokine receptor binding         8
16 GO:0044325                         ion channel binding        27
17 GO:0030515                              snoRNA binding         4
18 GO:0003735          structural constituent of ribosome        25
19 GO:0050699                           WW domain binding         5
20 GO:0017112 Rab guanyl-nucleotide exchange factor ac...         6
   Significant Expected Rank in classicFisher classicFisher classicKS
1            9     3.57                    20       0.00802   0.00017
2            1     0.32                   191       0.27977   0.00028
3            3     0.14                     3       9.3e-05   0.00250
4            3     0.14                     4       9.3e-05   0.00250
5            3     0.46                    21       0.00882   0.00354
6           12     8.60                   147       0.14534   4.2e-06
7            1     0.46                   235       0.37447   0.00364
8            9     4.16                    38       0.02102   0.00050
9            1     1.14                   320       0.69179   0.00747
10           1     0.73                   279       0.52843   0.00801
11           5     1.19                    15       0.00554   0.00919
12           0     0.41                   388       1.00000   0.00925
13           1     0.18                   152       0.17089   0.00944
14           1     0.37                   204       0.31282   0.01124
15           1     0.37                   205       0.31282   0.01124
16           7     1.23                     6       0.00014   0.01204
17           0     0.18                   389       1.00000   0.01243
18           0     1.14                   390       1.00000   0.01295
19           0     0.23                   391       1.00000   0.01346
20           2     0.27                    47       0.02755   0.01445
   elimFisher  elimKS
1     0.00802 0.00017
2     0.27977 0.00028
3     9.3e-05 0.00250
4     9.3e-05 0.00250
5     0.00882 0.00354
6     0.52856 0.00360
7     0.37447 0.00364
8     0.27691 0.00717
9     0.69179 0.00747
10    0.52843 0.00801
11    0.00554 0.00919
12    1.00000 0.00925
13    0.17089 0.00944
14    0.31282 0.01124
15    0.31282 0.01124
16    0.00014 0.01204
17    1.00000 0.01243
18    1.00000 0.01295
19    1.00000 0.01346
20    0.02755 0.01445

Por último queremos buscar genes en una de las categorías GO. La función printGenes, está hecha para esa tarea. Hagámoslo para la actividad proteína tirosina cinasa (GO:0004713) como un ejemplo.

gt <- printGenes(GOdataMF,
whichTerms = "GO:0004713", chip = "hgu95av2.db",
numChar = 40)
gt
              Chip ID LL.id Symbol.id
1636_g_at   1636_g_at    25      ABL1
39730_at     39730_at    25      ABL1
1635_at       1635_at    25      ABL1
40480_s_at 40480_s_at  2534       FYN
2039_s_at   2039_s_at  2534       FYN
754_s_at     754_s_at   613       BCR
36643_at     36643_at    NA      <NA>
38662_at     38662_at  5610   EIF2AK2
34877_at     34877_at  3716      JAK1
537_f_at     537_f_at   613       BCR
2057_g_at   2057_g_at  2260     FGFR1
1007_s_at   1007_s_at    NA      <NA>
760_at         760_at  8445     DYRK2
1333_f_at   1333_f_at   613       BCR
2056_at       2056_at  2260     FGFR1
854_at         854_at   640       BLK
41594_at     41594_at  3716      JAK1
1065_at       1065_at  2322      FLT3
34583_at     34583_at  2322      FLT3
33804_at     33804_at  2185     PTK2B
40742_at     40742_at  3055       HCK
1498_at       1498_at  7535     ZAP70
40936_at     40936_at 51232     CRIM1
36264_at     36264_at  4145      MATK
1844_s_at   1844_s_at  5604    MAP2K1
1810_s_at   1810_s_at  5580     PRKCD
36909_at     36909_at  7465      WEE1
993_at         993_at  7297      TYK2
39931_at     39931_at  8444     DYRK3
36115_at     36115_at  1198      CLK3
2059_s_at   2059_s_at  3932       LCK
2075_s_at   2075_s_at    NA      <NA>
33238_at     33238_at  3932       LCK
292_s_at     292_s_at  1195      CLK1
32833_at     32833_at  1195      CLK1
1622_at       1622_at  5606    MAP2K3
1768_s_at   1768_s_at  1445       CSK
38118_at     38118_at  6464      SHC1
1008_f_at   1008_f_at  5610   EIF2AK2
1512_at       1512_at  1859    DYRK1A
36946_at     36946_at  1859    DYRK1A
1630_s_at   1630_s_at  6850       SYK
1130_at       1130_at  5604    MAP2K1
1402_at       1402_at  4067       LYN
32616_at     32616_at  4067       LYN
36885_at     36885_at  6850       SYK
                                             Gene name raw p-value
1636_g_at  c-abl oncogene 1, non-receptor tyrosine ...    9.00e-11
39730_at   c-abl oncogene 1, non-receptor tyrosine ...    5.73e-10
1635_at    c-abl oncogene 1, non-receptor tyrosine ...    1.95e-07
40480_s_at       FYN oncogene related to SRC, FGR, YES    0.000341
2039_s_at        FYN oncogene related to SRC, FGR, YES    0.002151
754_s_at                     breakpoint cluster region    0.027205
36643_at                                            NA    0.028651
38662_at   eukaryotic translation initiation factor...    0.036347
34877_at                                Janus kinase 1    0.048349
537_f_at                     breakpoint cluster region    0.065386
2057_g_at          fibroblast growth factor receptor 1    0.065447
1007_s_at                                           NA    0.080622
760_at     dual-specificity tyrosine-(Y)-phosphoryl...    0.084581
1333_f_at                    breakpoint cluster region    0.116256
2056_at            fibroblast growth factor receptor 1    0.136657
854_at                      B lymphoid tyrosine kinase    0.142854
41594_at                                Janus kinase 1    0.158560
1065_at                  fms-related tyrosine kinase 3    0.224691
34583_at                 fms-related tyrosine kinase 3    0.225452
33804_at                protein tyrosine kinase 2 beta    0.288513
40742_at                       hemopoietic cell kinase    0.328005
1498_at    zeta-chain (TCR) associated protein kina...    0.339735
40936_at   cysteine rich transmembrane BMP regulato...    0.340416
36264_at      megakaryocyte-associated tyrosine kinase    0.439155
1844_s_at  mitogen-activated protein kinase kinase ...    0.486525
1810_s_at                      protein kinase C, delta    0.502015
36909_at                     WEE1 G2 checkpoint kinase    0.577787
993_at                               tyrosine kinase 2    0.577787
39931_at   dual-specificity tyrosine-(Y)-phosphoryl...    0.659157
36115_at                             CDC-like kinase 3    0.710543
2059_s_at  lymphocyte-specific protein tyrosine kin...    0.727480
2075_s_at                                           NA    0.754511
33238_at   lymphocyte-specific protein tyrosine kin...    0.768520
292_s_at                             CDC-like kinase 1    0.786830
32833_at                             CDC-like kinase 1    0.799613
1622_at    mitogen-activated protein kinase kinase ...    0.807841
1768_s_at                        c-src tyrosine kinase    0.888941
38118_at   SHC (Src homology 2 domain containing) t...    0.896863
1008_f_at  eukaryotic translation initiation factor...    0.909363
1512_at    dual-specificity tyrosine-(Y)-phosphoryl...    0.918548
36946_at   dual-specificity tyrosine-(Y)-phosphoryl...    0.924559
1630_s_at                       spleen tyrosine kinase    0.929048
1130_at    mitogen-activated protein kinase kinase ...    0.932251
1402_at    v-yes-1 Yamaguchi sarcoma viral related ...    0.969757
32616_at   v-yes-1 Yamaguchi sarcoma viral related ...    0.981146
36885_at                        spleen tyrosine kinase    0.999958

Este ejercicio está basado y adaptado en una práctica de Stale Nygard de Bioinformatics core facility, OUS/UiO.

Código Completo:

Bibliografía

  1. (). Gene expression profiles of B-lineage adult acute lymphocytic leukemia reveal genetic patterns that identify lineage derivation and distinct mechanisms of transformation. Clinical Cancer Research, 11(20). 7209–7219. https://doi.org/10.1158/1078-0432.ccr-04-2165

  2. (). Microarray data lab.. Retrieved from http://friveroll.github.io/pdfs/R-lab-sn.pdf