[BioC] plotting a CA

aedin culhane aedin at jimmy.harvard.edu
Tue Mar 13 19:57:22 CET 2012


Hi Aoife

Regarding your selection

1)codonCA is the results of a CA on your matrix codonData.  codonCA$genes doesn't exist. Are trying to add an element to the list codonCA or to your data matrix codonData?


2)list1<-c("gene2", "gene4")
Calling a vector "list1" might be confusing as it does not have class list



3) The following options will work:

>  codonData<- matrix(c(4, 7, 0.2, 3, .1, 7, 222, 3, 10, 5, 11,  8, 8, 10, 7),  ncol=3, dimnames = list(c("gene1","gene2", "gene3", "gene4", "gene5"), c("codon1", "codon2","codon3")))

>  codonData
       codon1 codon2 codon3
gene1    4.0      7     11
gene2    7.0    222      8
gene3    0.2      3      8
gene4    3.0     10     10
gene5    0.1      5      7
>  class(codonData)
[1] "matrix"
>  
>  rownames(codonData)
[1] "gene1" "gene2" "gene3" "gene4" "gene5"
>  rownames(codonData)%in%list1
[1] FALSE  TRUE FALSE  TRUE FALSE
>  factor(rownames(codonData)%in%list1, ,c("Special","NotSpecial"))
[1] Special    NotSpecial Special    NotSpecial Special
Levels: Special NotSpecial

## Can't add a character vector to a numerical matrix so need to convert to a data.frame

>  codonData<-as.data.frame(codonData)
>  codonData
       codon1 codon2 codon3
gene1    4.0      7     11
gene2    7.0    222      8
gene3    0.2      3      8
gene4    3.0     10     10
gene5    0.1      5      7
>  class(codonData)
[1] "data.frame"
>  
>  codonData$mycells<-factor(rownames(codonData)%in%list1, ,c("Special","NotSpecial"))

>  codonData
       codon1 codon2 codon3    mycells
gene1    4.0      7     11    Special
gene2    7.0    222      8 NotSpecial
gene3    0.2      3      8    Special
gene4    3.0     10     10 NotSpecial
gene5    0.1      5      7    Special


Or

>  codonCA$mycells<-factor(rownames(codonData)%in%list1, ,c("Special","NotSpecial"))


*****NOTE****
There are two comma when calling factor,

factor(x = character(), levels, labels = levels,
        exclude = NA, ordered = is.ordered(x))


This is because  c("Special","NotSpecial")is a labels parameter. If you 
neglect the two commas, it tries to send

c("Special","NotSpecial") to level which will fail as these are not the levels of the factor


>  levels(factor(rownames(codonData)%in%list1))
[1] "FALSE" "TRUE"



>  codonCA$mycells<-factor(rownames(codonData)%in%list1 ,c("Special","NotSpecial"))
>  codonCA$mycells
[1]<NA>  <NA>  <NA>  <NA>  <NA>
Levels: Special NotSpecial
>  codonCA$mycells<-factor(rownames(codonData)%in%list1, ,c("Special","NotSpecial"))
>  codonCA$mycells
[1] Special    NotSpecial Special    NotSpecial Special
Levels: Special NotSpecial
>  codonCA$mycells<-factor(rownames(codonData)%in%list1,labels=c("Special","NotSpecial"))
>  codonCA$mycells
[1] Special    NotSpecial Special    NotSpecial Special
Levels: Special NotSpecial





On 3/13/2012 10:48 AM, aoife doherty wrote:
> May I please pick your brain once more! I used the code you sent and 
> modified it slightly but i just need help with one part, also i 
> appreciate the reading you sent (to Ms. Culhane)......
>
> so I've highlighted the awkward part in yellow, but i've sent the full 
> code so as to provide context:
>
>
> #### Increase max print, load libraries
> options(max.print=10000000)
> library(ca)
> library(made4)
>
>
>
> ####read in a test matrix
> codonData <- matrix(c(4, 7, 0.2, 3, .1, 7, 222, 3, 10, 5, 11,  8, 8, 
> 10, 7),  ncol=3, dimnames = list(c("gene1","gene2", "gene3", "gene4", 
> "gene5"), c("codon1", "codon2","codon3")))
>
>
> #### make function
> plotCA<-function(dudi, rowFac, cols, plotgroups=FALSE, 
> plotrowLabels=FALSE, pch=c(1:levels(rowFac))+10, xax =1,  yax = 2,  ...) {
>
>  require(made4)
>
>  fac2char<-function(fac, newLabels) {
>       cLab<- class(newLabels)
>       if (!length(levels(fac))==length(newLabels)) stop("Number does 
> not equal to number of factor levels")
>       vec<-as.character(factor(fac, labels=newLabels))
>       if(inherits(newLabels, "numeric")) vec<-as.numeric(vec)
>       return(vec)
>       }
>
>
>  if (plotgroups)  s.groups(dudi$li, fac,  col=cols)
>  if (!plotgroups) {
>    pchs<-fac2char(rowFac, pch)
>    cols<-fac2char(rowFac, cols)
>
>
>    if (!plotrowLabels) s.var(dudi$li, boxes=FALSE, pch=pchs, col=cols, 
> cpoint=2, clabel=0, xax=xax, yax=yax,  ...)
>    if (plotrowLabels)  s.var(dudi$li, boxes=FALSE, col=cols,  xax=xax, 
> yax=yax,  ...)
>  }
>
>  s.var(dudi$co, boxes=FALSE, pch=19, col="black", add.plot = TRUE, 
> xax=xax, yax=yax,  ...)
> }
>
> ## run CA analysis
> codonCA<-ord(t(codonData))
>
> > codonCA
> $ord
> Duality diagramm
> class: coa dudi
> $call: dudi.coa(df = data.tr <http://data.tr>, scannf = FALSE, nf = 
> ord.nf <http://ord.nf>)
>
> $nf: 2 axis-components saved
> $rank: 2
> eigen values: 0.3946 0.03043
>   vector length mode    content
> 1 $cw    5      numeric column weights
> 2 $lw    3      numeric row weights
> 3 $eig   2      numeric eigen values
>
>   data.frame nrow ncol content
> 1 $tab       3    5    modified array
> 2 $li        3    2    row coordinates
> 3 $l1        3    2    row normed scores
> 4 $co        5    2    column coordinates
> 5 $c1        5    2    column normed scores
> other elements: N
>
> $fac
> NULL
>
> attr(,"class")
> [1] "coa" "ord"
>
>
> ## Create a factor which list the groups of "nodes" of interest
>
> ### This next section is the section i was trying to change.
> My aim is that if codonData is as described above:
>
> > codonData
>       codon1 codon2 codon3
> gene1    4.0      7     11
> gene2    7.0    222      8
> gene3    0.2      3      8
> gene4    3.0     10     10
> gene5    0.1      5      7
>
> for example i find gene2 and gene5 interesting, i want all the nodes 
> in the plot to be black,
> *except for gene 2 and gene 5 that i want to both be red* (or whatever).
>
> So i understand i need to make a factor to group these variables. I 
> think this command:
> fac<-factor(c(rep("Node1",3), rep("Node2", 2)))
> fac
>
> took my data and said that the first 3 rows (ie. gene 1,2 and 3) were 
> level one (and labelled node1)
> and gene4 and gene5 were level two (and labelled node 2).
>
> so, similar to this, i also want to set two levels, one for my node of 
> interest, one for the interesting nodes,
> and one for everything else.
>
> so i did:
>
> list1 <-c("gene2", "gene4")
> to read my interesting rows as a vector.
>
> Then i wanted to say:
> look at the cells in my vector list1 and table. if in vector list1 and 
> table, change to a factor
> (I should acknowledge that i robbed this from the R forum...!)
>
>
> > codonData$mycells <-factor(codonCA$genes %in% 
> list1,c("Special","NotSpecial"))
> Error in codonData$cells : $ operator is invalid for atomic vectors
>
>
> and then once i had found the interesting nodes in my CA analysis, 
> just do as before:
>
>
> codonCA<-dudi.coa(codonData, scan=FALSE)
> plotCA(codonCA, rowFac=fac,pch=c(18,20), cols=c("red", "blue"))
>
>
>
> Miss Singh, I know you were asking something similar about factors and 
> levels and stuff,
> I've read a bit about them, basically a factor is a type of variable, 
> and as an optional
> argument you can add a level which determines the categories of factor 
> variables, and the
> label is a vector of values that will be the labels of categories in 
> levels argument...
>
> I don't know if that can help your error...
>
> Also may I point out that I didn't try just this one way and I'm 
> already asking for help, I've been stuck on this for over a day, it's 
> so much to take in at once!
>
> Aoife
>
> On Sat, Mar 10, 2012 at 2:28 PM, Aedin <aedin at jimmy.harvard.edu 
> <mailto:aedin at jimmy.harvard.edu>> wrote:
>
>     Hi Aoife
>     Welcome to R. I understand it can seem tough at first. But you are
>     learning a language that will be wonderful once you do. I find new
>     users like the Rstudio.org interface to R
>
>     Scan works easy for a one column file. It will read it in as a
>     vector that you then have to convert to a factor. It's more
>     complicated when you have >1 column
>
>     In that case you might find it easier to create an annotation file
>     in excel. Save it as a csv  (comma delimited)  file  It can
>     contain >1 column  eg a column of gene names and a second of
>     categories etc. then use read.csv  to read it into R  Then select
>     the column you want eg if it's the second column:
>
>     annot<~read.csv("file.csv", header=TRUE)
>     myFac<-annot[,2]
>     ?scan
>
>     read.csv or read.table will read any categorical column as a
>     factor by default. Use? To get help on a function. Or use
>     help.search to search for a function. The website rseek.org
>     <http://rseek.org> is a good google like search engine for all
>     things R
>
>     There are several intro to R textbooks which might be useful to me
>       I can send you a list if you wish  Or look at Tom Girke UC
>     riverside's  online class or i link course notes on an intro to R
>     class I teach on my website.
>
>     Good luck
>     Aedin
>
>     On Mar 10, 2012, at 5:50, aoife doherty <aoife.m.doherty at gmail.com
>     <mailto:aoife.m.doherty at gmail.com>> wrote:
>
>     > change
>
>

-- 
Aedin Culhane
Computational Biology and Functional Genomics Laboratory
Harvard School of Public Health,
Dana-Farber Cancer Institute

web: http://www.hsph.harvard.edu/research/aedin-culhane/
email: aedin at jimmy.harvard.edu
phone: +1 617 632 2468
Fax: +1 617 582 7760


Mailing Address:
Attn: Aedin Culhane, SM822C
450 Brookline Ave.
Boston, MA 02215



More information about the Bioconductor mailing list