格子中的格子图:改变点和x比例

时间:2014-06-17 20:17:01

标签: r expression point lattice trellis

我正在尝试用莱迪思制作Trellis图,但我无法按照自己的意愿制作。我喜欢它到目前为止看起来如何,我只是需要一些帮助来调整它以完全看我想要的东西。 我会给你我想要绘制的数据,我正在使用的R代码,我得到的图表,以及我想要制作的图表。
1.以下是数据:CSV File
这是我的R代码:

Infection<-read.table("stack.csv", header=TRUE, sep=",")
attach(Infection)
head(Infection)
Infection.st<-stack(Infection[,2:13])
head(Infection.st)
Infection.st[,"gene"]<-Infection[,1]
head(Infection.st)
summary(Infection.st$ind)
Infection.st$ind<-factor(Infection.st$ind, levels=c("Disease.12h", "Control.12h", "Disease.4d", "Control.4d",
                                                    "Disease.3h", "Control.3h", "Disease.24h", "Control.24h",
                                                    "Disease.48h", "Control.48h", "Disease.72h", "Control.72h"))
summary(Infection.st$ind)

xyplot(values~ind|gene, xlab = NULL,layout=c(7,16), main="Gene Expression after infection", auto.key=list(columns = 6, cex = .8),
       pch = 21, cex = .7, scales = list(x = list(draw = FALSE)), data=Infection.st, group=ind)

3)以下是我得到的图表:https://dl.dropboxusercontent.com/u/62277598/Stack.pdf(删除冒号后的空格)
4)最后我想要的图形如下所示:Desired Graph
   现在我想在我的图表中得到以下内容,您可以在我手绘的图片中看到:
a)每个时间点有不同的符号,但疾病空和控制填充(相同的颜色是可以的)。另一个选择是为每个点设置不同类型的项目,并改变疾病和控制的颜色(例如,红色和绿色)。
b)改变x轴的比例。由于它是时间序列数据,因此表示它会很好。然而,这并不准确。例如,12小时和4天之间只有一个空格,4天后空间更小。在每个时间点关闭疾病和控制样本会很好 c)如果我能改变规模,那将是很好的。有一些低表达的基因,我只是在一个新图中绘制它。我想将表达式排序4天,然后将基因按表达水平分组 PS:我没有10个声望发布超过两个链接或图像。 谢谢你的时间。

1 个答案:

答案 0 :(得分:1)

前一段时间我问了这个问题。这是解决方案。我唯一没做的就是改变时间点之间的距离。这实际上是不必要的。

library("latticeExtra")
library("scales")

#Command sets the working directory
setwd("/your-directory")

OR<-read.table("stack.csv", header=TRUE, sep=",")
attach(OR)
head(OR)
OR.st<-stack(OR[,2:13])
head(OR.st)
OR.st[,"gene"]<-OR[,1]
head(OR.st)
summary(OR.st$ind)
OR.st$ind<-factor(OR.st$ind, levels=c("Disease-12h", "Disease-4d", "Control-4d", "Disease-3h", "Control-3h", "Disease-24h","Control-24h", "Disease-48h", "Control-48h", "Disease-72h","Control-72h")
summary(OR.st$ind)

#comand to make symbols for each time point
supsym <- trellis.par.get("superpose.symbol")
supsym$col <- c("gold","gold","coral","coral","green","green","red","red","blueviolet","blueviolet","cornflowerblue","cornflowerblue","azure4", "azure4") #this is the line around the symbol
supsym$fill <- c("gold","gold","coral","coral","green","green","red","red","blueviolet","blueviolet","cornflowerblue","cornflowerblue","azure4", "azure4")  #this is the color to fill the symbols
supsym$pch <- c(15,19,23, 24, 15,19,15,19,15,19,15,19,15,19,15,19) #here is where you can change the type of symbol you are using
supsym$cex <- c(.8,.8,.8,.7,.8,.8,.8,.8,.8,.8,.8,.8,.8,.8,.8,.8,.8) #here you can change the size of each symbol
trellis.par.set("superpose.symbol",supsym)
colors()
options(scipen=10)
options(digits=10)

#below is just setting the color of each panel headings
bgColors <- c("gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44",
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44",
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44", 
              "gray44", "gray80", "gray44", "gray80", "gray44")

txtColors <- c("white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white",
               "white", "black", "white", "black", "white")


# Create a function to be passes to "strip=" argument of xyplot
myStripStyle <- function(which.panel, factor.levels, ...) {
  panel.rect(0, 0, 1, 1,
             col = bgColors[which.panel],
             border = 1)
  panel.text(x = 0.5, y = 0.5,
             font=2,
             lab = factor.levels[which.panel],
             col = txtColors[which.panel])
}       



print(xyplot(values~ind|Gene,groups=ind,data=OR.st,
             layout=c(5,7),as.table=TRUE,
             type="p",
             par.strip.text=list(custBgCol=bgColors,
                                 custTxtCol=txtColors),
             strip=myStripStyle,
             auto.key=list(text=c("Disease-12h", "Disease-4d", "Control-4d", "Disease-3h",
             "Control-3h", "Disease-24h","Control-24h", "Disease-48h", "Control-48h", "Disease-72h","Control-72h"),
                           space="bottom", columns=7, pch=8, cex=.8),
             relation="same",
             #use relation="sliced", to have same scales across panels
             #scales = list(x = list(draw = FALSE),y=list(log=TRUE)),
             scales = list(x = list(draw = FALSE, abbreviate = FALSE), y = list(log = 10)),
             yscale.components = yscale.components.log10ticks,
             #aspect = "y",
             #scales=list(alternating=FALSE),
             #between=.5,#space between
             main="Gene Expression after Infection",
             #ylim=c(0,1000),#this changes the y limits
             xlab="",
             ylab=expression('RPKMs')))

如果您有任何问题,请与我们联系。