1

我正在尝试用 Lattice 制作一个格子图，但我无法按照我的意愿制作它。到目前为止，我喜欢它的外观，我只需要一些帮助来调整它以使其看起来完全符合我的要求。我会给你我试图绘制的数据，我正在使用的 R 代码，我得到的图表，最后是我想要制作的图表。
1. 这是数据：CSV 文件
2. 这是我的 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
Now I would喜欢在我的图表中得到以下内容，正如您在我的手工制作的图片中看到的那样：
a）每个时间点都有不同的符号，但疾病是空的，控制是填充的（相同的颜色是可以的）。另一种选择是为每个点设置不同类型的项目，并根据疾病和控制改变颜色（例如，红色和绿色）。
b) 改变 x 轴的比例。由于它是时间序列数据，因此可以很好地表示它。然而，它并不精确。例如，12h 和 4 天之间只有一个空格，然后 4 天后的空格更小。在每个时间点关闭疾病和对照样本会很好。
c) 最后，如果我能改变比例就好了。有一些基因表达量低，我只是将其绘制在一个新图表中。我想按 4 天对表达进行排序，然后将基因按表达水平分组。
PS：我没有 10 声望来发布两个以上的链接或图片。谢谢你的时间。

4

1 回答 1

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')))

如果您有任何问题，请告诉我。

于 2014-09-18T14:59:13.607 回答