我有heatmap(来自一组样本的基因表达):
set.seed(10)
mat <- matrix(rnorm(24*10,mean=1,sd=2),nrow=24,ncol=10,dimnames=list(paste("g",1:24,sep=""),paste("sample",1:10,sep="")))
dend <- as.dendrogram(hclust(dist(mat)))
row.ord <- order.dendrogram(dend)
mat <- matrix(mat[row.ord,],nrow=24,ncol=10,dimnames=list(rownames(mat)[row.ord],colnames(mat)))
mat.df <- reshape2::melt(mat,value.name="expr",varnames=c("gene","sample"))
require(ggplot2)
map1.plot <- ggplot(mat.df,aes(x=sample,y=gene))+geom_tile(aes(fill=expr))+scale_fill_gradient2("expr",high="darkred",low="darkblue")+scale_y_discrete(position="right")+
theme_bw()+theme(plot.margin=unit(c(1,1,1,-1),"cm"),legend.key=element_blank(),legend.position="right",axis.text.y=element_blank(),axis.ticks.y=element_blank(),panel.border=element_blank(),strip.background=element_blank(),axis.text.x=element_text(angle=45,hjust=1,vjust=1),legend.text=element_text(size=5),legend.title=element_text(size=8),legend.key.size=unit(0.4,"cm"))
Run Code Online (Sandbox Code Playgroud)
(由于plot.margin我正在使用的论据,左侧被切断,但我需要这个,如下所示).
然后,我prune行dendrogram根据深度截止值来获得较少的集群(即,只有深深的分裂),并做一些编辑所产生dendrogram有它绘制他们的方式,我希望它:
depth.cutoff <- 11
dend <- cut(dend,h=depth.cutoff)$upper
require(dendextend)
gg.dend <- as.ggdend(dend)
leaf.heights <- dplyr::filter(gg.dend$nodes,!is.na(leaf))$height
leaf.seqments.idx <- which(gg.dend$segments$yend %in% leaf.heights)
gg.dend$segments$yend[leaf.seqments.idx] <- max(gg.dend$segments$yend[leaf.seqments.idx])
gg.dend$segments$col[leaf.seqments.idx] <- "black"
gg.dend$labels$label <- 1:nrow(gg.dend$labels)
gg.dend$labels$y <- max(gg.dend$segments$yend[leaf.seqments.idx])
gg.dend$labels$x <- gg.dend$segments$x[leaf.seqments.idx]
gg.dend$labels$col <- "black"
dend1.plot <- ggplot(gg.dend,labels=F)+scale_y_reverse()+coord_flip()+theme(plot.margin=unit(c(1,-3,1,1),"cm"))+annotate("text",size=5,hjust=0,x=gg.dend$label$x,y=gg.dend$label$y,label=gg.dend$label$label,colour=gg.dend$label$col)
Run Code Online (Sandbox Code Playgroud)
require(cowplot)
plot_grid(dend1.plot,map1.plot,align='h',rel_widths=c(0.5,1)) …Run Code Online (Sandbox Code Playgroud) 我有一个字符列表列表.例如:
l <- list(list("A"),list("B"),list("C","D"))
Run Code Online (Sandbox Code Playgroud)
因此,您可以看到一些元素是长度> 1的列表.
我想将此列表列表转换为字符向量,但我希望长度> 1的列表在字符向量中显示为单个元素.
该unlist功能并没有做到这一点,而是:
> unlist(l)
[1] "A" "B" "C" "D"
Run Code Online (Sandbox Code Playgroud)
还有什么比:
sapply(l,function(x) paste(unlist(x),collapse=""))
Run Code Online (Sandbox Code Playgroud)
为了得到我想要的结果:
"A" "B" "CD"
Run Code Online (Sandbox Code Playgroud) 我有一个z分数matrix:
set.seed(1)
z.score.mat <- matrix(rnorm(1000),nrow=100,ncol=10)
Run Code Online (Sandbox Code Playgroud)
这是一些生物实验数据的结果,以及相应的p值矩阵:
p.val.mat <- pnorm(abs(z.score.mat),lower.tail = F)
Run Code Online (Sandbox Code Playgroud)
两者都相同dimnames:
rownames(z.score.mat) <- paste("p",1:100,sep="")
colnames(z.score.mat) <- paste("c",1:10,sep="")
rownames(p.val.mat) <- paste("p",1:100,sep="")
colnames(p.val.mat) <- paste("c",1:10,sep="")
Run Code Online (Sandbox Code Playgroud)
我正在绘制heatmap像这样的z分数的分层聚类:
hc.col <- hclust(dist(z.score.mat))
dd.col <- as.dendrogram(hc.col)
col.ord <- order.dendrogram(dd.col)
hc.row <- hclust(dist(t(z.score.mat)))
dd.row <- as.dendrogram(hc.row)
row.ord <- order.dendrogram(dd.row)
clustered.mat <- z.score.mat[col.ord,row.ord]
clustered.mat.names <- attr(clustered.mat,"dimnames")
clustered.mat.df <- as.data.frame(clustered.mat)
colnames(clustered.mat.df) <- clustered.mat.names[[2]]
clustered.mat.df[,"process"] <- clustered.mat.names[[1]]
clustered.mat.df[,"process"] <- with(clustered.mat.df,factor(clustered.mat.df[,"process"],levels=clustered.mat.df[,"process"],ordered=TRUE))
require(reshape2)
clustered.mat.df <- reshape2::melt(clustered.mat.df,id.vars="process")
colnames(clustered.mat.df)[2:3] <- c("condition","z.score")
clustered.mat.df$p.value <- sapply(1:nrow(clustered.mat.df),function(x) p.val.mat[which(rownames(p.val.mat) == clustered.mat.df$process[x]),which(colnames(p.val.mat) …Run Code Online (Sandbox Code Playgroud) 我有5个x,y数据集,我正在使用R的plotly.
以下是数据:
set.seed(1)
df <- do.call(rbind,lapply(seq(1,20,4),function(i) data.frame(x=rnorm(50,mean=i,sd=1),y=rnorm(50,mean=i,sd=1),cluster=i)))
Run Code Online (Sandbox Code Playgroud)
这是他们的plotly散点图:
library(plotly)
clusters.plot <- plot_ly(marker=list(size=10),type='scatter',mode="markers",x=~df$x,y=~df$y,color=~df$cluster,data=df) %>% hide_colorbar() %>% layout(xaxis=list(title="X",zeroline=F),yaxis=list(title="Y",zeroline=F))
Run Code Online (Sandbox Code Playgroud)
然后,按照@Marco Sandri的回答,我使用以下代码添加限制这些集群的多边形:
多边形代码:
library(data.table)
library(grDevices)
splinesPolygon <- function(xy,vertices,k=3, ...)
{
# Assert: xy is an n by 2 matrix with n >= k.
# Wrap k vertices around each end.
n <- dim(xy)[1]
if (k >= 1) {
data <- rbind(xy[(n-k+1):n,], xy, xy[1:k, ])
} else {
data <- xy
}
# Spline …Run Code Online (Sandbox Code Playgroud) 我有一个data.frame我想使用到散点图R的plotly与我想颜色和形状两个因素.
这是我的数据:
set.seed(1)
df <- data.frame(x=rnorm(12),y=rnorm(12),
group=c(rep(1,3),rep(2,3),rep(3,3),rep(4,3)),
treatment=c(rep("A",6),rep("B",6)),
stringsAsFactors=F)
df$group <- factor(df$group,levels=1:4)
df$treatment <- factor(df$treatment,levels=c("A","B"))
Run Code Online (Sandbox Code Playgroud)
这是我试图绘制的方式:
require(plotly)
plot_ly(marker=list(size=10),type='scatter',mode="markers",x=~df$x,y=~df$y,color=~df$group,symbol=~df$treatment) %>%
add_annotations(text="group,treatment",xref="paper",yref="paper",x=1.02, xanchor="left",y=1.02,yanchor="top",legendtitle=TRUE,showarrow=FALSE) %>%
layout(xaxis=list(title="x"),yaxis=list(title="y"))
Run Code Online (Sandbox Code Playgroud)
是否可以将图例中的文本group与treatment逗号分隔,而不是像现在一样用新行分隔?
这意味着代替:
1
一个
2
一个
3
乙
4
乙
我会:
1,A
2,A
3,B
4,B
我有两个由R's创建的密度图plotly:
set.seed(1)
dens.1 <- density(runif(1000,0,100))
dens.2 <- density(runif(1000,100,10000))
df.1 <- data.frame(x=dens.1$x,y=dens.1$y)
df.2 <- data.frame(x=dens.2$x,y=dens.2$y)
library(plotly)
pl.1 <- plot_ly(x=~df.1$x,y=~df.1$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(title="Data1")
pl.2 <- plot_ly(x=~df.2$x,y=~df.2$y,type='scatter',mode='lines',line=list(color="#A9A9A9")) %>%
layout(xaxis=list(title="Count",zeroline=F),yaxis=list(title="Density",zeroline=F)) %>%
layout(title="Data2")
Run Code Online (Sandbox Code Playgroud)
现在,我想将它们绘制在一起。所以我用plotly的subplot:
subplot(list(pl.1,pl.2),nrows=1,shareX=F,shareY=F,titleX=T,titleY=T) %>% layout(showlegend=F)
Run Code Online (Sandbox Code Playgroud)
我如何在该情节上获得两个标题?
我想使用ggplot绘制直方图(或使用的步骤图stat_bin)并使用它覆盖几个点geom_point.
这是一个base实现:
library(plotrix)
set.seed(10)
df <- data.frame(id=LETTERS,val=rnorm(length(LETTERS)))
selected.ids <- sample(LETTERS,3,replace=F)
h <- hist(df$val,plot=F,breaks=10)
cols <- sapply(rainbow(length(selected.ids)),function(x) color.id(x)[1])
selected.df <- data.frame(id=selected.ids,col=cols,stringsAsFactors=F)
selected.df$x <- df$val[which(df$id %in% selected.ids)]
selected.df <- selected.df[order(selected.df$x),]
selected.df$y <- h$counts[findInterval(selected.df$x,h$breaks)]
selected.df$col <- factor(selected.df$col,levels=cols)
plot(h)
segments(x0=selected.df$x,x1=selected.df$x,y0=selected.df$y,y1=selected.df$y,cex=18,lwd=8,col=selected.df$col)
Run Code Online (Sandbox Code Playgroud)
这使:
但是,当我尝试ggplot:
ggplot(df,aes(x=val))+geom_histogram(bins=10,colour="black",alpha=0,fill="#FF6666")+geom_point(data=selected.df,aes(x=x,y=y,colour=factor(col)),size=2)+scale_fill_manual(values=levels(selected.df$col),labels=selected.df$id,name="id")+scale_colour_manual(values=levels(selected.df$col),labels=selected.df$id,name="id")
Run Code Online (Sandbox Code Playgroud)
理想情况下,我想使用步骤图绘制它:
ggplot(df,aes(x=val))+stat_bin(geom="step",bins=10)+geom_point(data=selected.df,aes(x=x,y=y,colour=factor(col)),size=2)+scale_fill_manual(values=levels(selected.df$col),labels=selected.df$id,name="id")+scale_colour_manual(values=levels(selected.df$col),labels=selected.df$id,name="id")
Run Code Online (Sandbox Code Playgroud)
这看起来非常像 geom_histogram
而且我也想让线的末端触及y = 0线.
所以我使用stat_bin在步骤图中得到正确的结果?
有没有办法在dot布局中绘制DAG (a-la Rgraphviz)ggnet?
我的例子是基因本体图,取自topGO的vignette:
library(topGO)
library(ALL)
data(ALL)
data(geneList)
affyLib <- paste(annotation(ALL),"db",sep= ".")
library(package=affyLib,character.only=TRUE)
topgo.obj <- new("topGOdata",description="Simple session",ontology="BP",allGenes=geneList,geneSel=topDiffGenes,nodeSize=10,annot=annFUN.db,affyLib=affyLib)
res.fisher <- runTest(topgo.obj,algorithm="classic",statistic="fisher")
res.df <- GenTable(topgo.obj,classicFisher=res.fisher,orderBy="classicFisher",topNodes=length(score(res.fisher)))
Run Code Online (Sandbox Code Playgroud)
为方便起见,我设置:
res.df$p.value <- as.numeric(res.df$classicFisher)
Run Code Online (Sandbox Code Playgroud)
我保留了topGO graphNELp值低于0.05 的唯一节点及其祖先:
topgo.graph <- graph(topgo.obj)
sig.cutoff <- 0.05
sig.node.names <- dplyr::filter(res.df,p.value < sig.cutoff)$GO.ID
topgo.graph <- reverseArch(inducedGraph(topgo.graph,sig.node.names))
Run Code Online (Sandbox Code Playgroud)
要使用ggnet我将graphNEL图形转换为igraph:
library(ggnet)
library(network)
library(sna)
library(scales)
library(igraph)
library(intergraph)
topgo.igraph <- graph_from_graphnel(topgo.graph,name=TRUE,weight=TRUE,unlist.attrs=TRUE)
topgo.network <- asNetwork(topgo.igraph,amap=attrmap())
ggnet2(net=topgo.network,size=10,arrow.size=12,arrow.gap=0.025)
Run Code Online (Sandbox Code Playgroud)
使用Rgraphviz的dot …
我有一个list的list矩阵。每个list都有相同的数量,matrices其中每个matrix都有相同的列数:
set.seed(1)
mat.lol <- list(list1=list(matrix(rnorm(100),ncol=10),matrix(rnorm(200),ncol=10),matrix(rnorm(140),ncol=10)),
list2=list(matrix(rnorm(80),ncol=10),matrix(rnorm(220),ncol=10),matrix(rnorm(110),ncol=10)),
list3=list(matrix(rnorm(300),ncol=10),matrix(rnorm(500),ncol=10),matrix(rnorm(650),ncol=10)))
Run Code Online (Sandbox Code Playgroud)
我想在所有列表中的rbind每一个matrix i,以便我最终list得到matrices:
mat.list <- list(rbind(mat.lol[[1]][[1]],mat.lol[[2]][[1]],mat.lol[[3]][[1]]),
rbind(mat.lol[[1]][[2]],mat.lol[[2]][[2]],mat.lol[[3]][[2]]),
rbind(mat.lol[[1]][[3]],mat.lol[[2]][[3]],mat.lol[[3]][[3]]))
Run Code Online (Sandbox Code Playgroud)
apply function实现这一目标的将是什么?
我有一个matrix(来自几个条件的基因表达):
set.seed(1)
mat <- matrix(rnorm(50*10),nrow=50,ncol=10,dimnames=list(paste("C",1:50,sep="."),paste("G",1:10,sep=".")))
Run Code Online (Sandbox Code Playgroud)
我想将其绘制为heatmap使用plotlyin R。
require(plotly)
heatmap.plotly <- plot_ly(x=colnames(mat),y=rownames(mat),z=mat,type="heatmap",colors=colorRamp(c("darkblue","white","darkred")),colorbar=list(title="Score",len=0.4)) %>%
layout(yaxis=list(title="Condition"),xaxis=list(title="Gene"))
Run Code Online (Sandbox Code Playgroud)
工作正常。
但是,我想添加仅在悬停时才能看到的文本。
我认为这会奏效:
conditions.text <- paste(paste("C",1:50,sep="."),rep(paste(LETTERS[sample(26,10,replace=T)],collapse=""),50),sep=":")
heatmap.plotly <- plot_ly(x=colnames(mat),y=rownames(mat),z=mat,type="heatmap",colors=colorRamp(c("darkblue","white","darkred")),colorbar=list(title="Score",len=0.4),hoverinfo='text',text=~conditions.text) %>%
layout(yaxis=list(title="Condition"),xaxis=list(title="Gene"))
Run Code Online (Sandbox Code Playgroud)
但事实并非如此。将鼠标悬停在情节上时,我实际上看不到任何文字。
请注意,我正在使用 amatrix而不是melted data.frame.