开发者

align axes in double plot ggplot R

How can I align the two ggplots in the following function so that the x-axis is corresponding between the table and the graph ? As it is now the interval between the "ticks" is less in the table. Any ideas?

//M

Edit: Forgot to give credit to the learnr website for the table plotting method....

function ggkm:

ggkm<-function(time,event,stratum="-1",tit="",xscale=round(seq(0,max(time),by=max(time)/10),0)) {
    lev<-levels(factor(stratum))
    w2<-lev[1]!="-1"

    if (w2) {stratum<-as.factor(stratum)}

    m2s<-Surv(time,as.numeric(event))
    if (w2) {fit <- survfit(m2s~stratum)}
    else fit<-survfit(m2s~-1) 

    w<-fit$time

    k<-fit$surv

    o<-length(levels(stratum))

        strata<-c(rep(names(fit$strata[1:o]),fit$strata[1:o]))
        lev2<-levels(as.factor(strata))
    upper<-fit$upper
    lower<-fit$lower
    if (w2) {f<-data.frame(w,k,strata,upper,lower)} 
    else f<-data.frame(w,k,upper,lower)
    if (w2) {r<-ggplot (f,aes(x=w,y=k,fill=strata,group=strata))+geom_line(aes(color=strata))+scale_fill_brewer(f$strata,palette="Set1")+scale_color_brewer(f$strata,palette="Set1")}
    else r<-ggplot(f,aes(x=w,y=k))+geom_line()
    r<-r+geom_ribbon(aes(ymin=lower,ymax=upper),alpha=0.3)+opts(title=tit)
    r<-r+opts(panel.grid.minor=theme_blank(),panel.grid.major=theme_blank(),panel.background=theme_blank(),axis.line=theme_segment())
    r<-r+opts(legend.position=c(0.8,0.8))
    #r<-r+opts(legend.title="")
    if (w2) {
        r<-r+scale_fill_brewer("",palette="Set1",breaks=lev2,labels=lev)+scale_color_brewer("",palette="Set1",breaks=lev2,labels=lev)
        }
    r<-r+geom_hline(yintercept=0.5,linetype=2)
    r+expand_limits(x = 0, y = 0)+scale_x_continuous("Observation time (months)",expand = c(0, 0),breaks=xscale,labels=xscale,limits=c(min(xscale),max(xscale)))+scale_y_continuous("Probability of overall survival (proportion)",expand = c(0,0))->r


##number at risk table
    u<-llply(names(fit$strata),function(x) rep(x,fit$strata[x]))
    p<-ldply(u,function(x) data.frame(x))
    fit2<-data.frame(p,fit$n.risk,fit$surv,fit$time,fit$n.event)
    q<-dlply(fit2,.(x),function(g) data.frame(g$fit.n.risk,g$fit.surv,g$fit.time,g$fit.n.event))
    e<-ldply(q,function(y){
    o<-ldply(xscale,function(x) y[min(which((x-y$g.fit.time<0))),1])
    oo<-cbind(o,xscale)
    })
    melt(e,id=c("xscale","x"))->e2
    e2$strata<-as.factor(e2$x)
    cast(subset(e2,e2$variable!="x.time"),strata~xscale,identity)->e3
    #e3[["strata"]]<-names(e3[["strata"]])
    dg<-ggplot(e2,aes(x=xscale,y=strata,color=strata,label=format(factor(value),nsmall=1)))+geom_text(size=2.5)+theme_bw()+scale_color_brewer(e2$strata,palette="Set1")

    #levels(e2$strata)<-lev
    dg<-dg+scale_y_discrete(limits=e2$strata)+expand_limits(x=0,y=0)
    dg<-dg+opts(panel.grid.minor=theme_blank(),panel.grid.major=theme_blank(),panel.background=theme_blank(),axis.line=theme_blank())
    dg<-dg+opts(panel.border=theme_blank(),axis.text.x=theme_blank(),axis.text.y=theme_blank(),axis.ticks=theme_blank())
    #dg<-dg+opts(panel.border=theme_blank(),axis.text.x=theme_blank(),axis.ticks=theme_blank())

    dg<-dg+opts(plot.margin开发者_C百科 = unit(c(-0.5,1, 0, 0.5), "lines")) + xlab(NULL) + ylab(NULL)+labs(colour="")
    dg<-dg+opts(legend.position="none")
##Same page
    Layout <- grid.layout(nrow = 2, ncol = 1, heights = unit(c(2,0.25), c("null", "null")))

    grid.show.layout(Layout)

    vplayout <- function(...) {
             grid.newpage()
             pushViewport(viewport(layout = Layout))
   }
   subplot <- function(x, y) viewport(layout.pos.row = x,layout.pos.col = y)

   mmplot <- function(a, b) {
     vplayout()
     print(a, vp = subplot(1, 1))
     print(b, vp = subplot(2, 1))
 } 
    t<-mmplot(r, dg)

return(t)
} 

example using ggkm (albeit a poor dataset)

library(survival)
require(ggplot2)
data(leukemia)
with(leukemia,ggkm(time,status,x,tit="Leukemia"))
0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜