R/cma.uni.plot.R

cma.uni.plot <-
function(re.cma.sens,re.cma=NULL,delta=NULL,legend.pos="topright",xlab=expression(delta),ylab=expression(hat(AB)),
                       cex.lab=1,cex.axis=1,lgd.cex=1,lgd.pt.cex=1,plot.delta0=TRUE,...)
{
  dt<-re.cma.sens$Coefficients[,"delta"]
  AB.p<-re.cma.sens$Coefficients[,"ABp.Estimate"]
  AB.p.ub<-re.cma.sens$Coefficients[,"ABp.UB"]
  AB.p.lb<-re.cma.sens$Coefficients[,"ABp.LB"]
  idx<-sort(AB.p,index.return=TRUE)$ix
  
  #################################################
  # plot delta = 0 result or not
  if(!is.null(re.cma))
  {
    if(re.cma$delta==0)
    {
      plot.delta0<-FALSE
    }
  }
  if(!is.null(delta))
  {
    if(length(which(delta==0))>0)
    {
      plot.delta0<-FALSE
    }
  }
  #################################################
  
  plot(range(dt[idx]),range(c(AB.p.lb,AB.p.ub)),type="n",xlab=xlab,ylab=ylab,cex.lab=cex.lab,cex.axis=cex.axis)
  polygon(c(rev(dt),dt),c(rev(AB.p.ub),AB.p.lb),col="grey80",border=NA)
  abline(v=0)
  abline(h=0)
  if(plot.delta0)
  {
    abline(h=AB.p[which(dt==0)],lty=2,col=2) 
  }
  lines(dt,AB.p,lwd=2)
  lines(dt,AB.p.lb,lty=2,col=8)
  lines(dt,AB.p.ub,lty=2,col=8)
  
  if(!is.null(re.cma))
  {
    points(re.cma$delta,re.cma$Coefficients["ABp",1],pch=16,col=4,cex=0.75)
    lines(rep(re.cma$delta,2),re.cma$Coefficients["ABp",c(3,4)],lty=2,col=4)
    lines(c(re.cma$delta-0.02,re.cma$delta+0.02),rep(re.cma$Coefficients["ABp",3],2),col=4)
    lines(c(re.cma$delta-0.02,re.cma$delta+0.02),rep(re.cma$Coefficients["ABp",4],2),col=4)
    
    if(plot.delta0)
    {
      legend(legend.pos,legend=c(expression(delta==0),
                                 substitute(delta==d,list(d=round(re.cma$delta,digits=3)))),
             lty=2,col=c(2,4),pch=c(NA,16),pt.cex=lgd.pt.cex,bty="n",cex=lgd.cex) 
    }else
    {
      legend(legend.pos,legend=substitute(delta==d,list(d=round(re.cma$delta,digits=3))),
             lty=2,col=4,pch=16,pt.cex=lgd.pt.cex,bty="n",cex=lgd.cex)
    }
  }
  if(!is.null(delta))
  {
    for(j in 1:length(delta))
    {
      idx.tmp<-which.min(abs(dt-delta[j]))
      
      points(dt[idx.tmp],AB.p[idx.tmp],pch=16,col=4,cex=0.75)
      lines(rep(dt[idx.tmp],2),c(AB.p.lb[idx.tmp],AB.p.ub[idx.tmp]),lty=2,col=4)
      lines(c(dt[idx.tmp]-0.02,dt[idx.tmp]+0.02),rep(AB.p.lb[idx.tmp],2),col=4)
      lines(c(dt[idx.tmp]-0.02,dt[idx.tmp]+0.02),rep(AB.p.ub[idx.tmp],2),col=4)
    }
    
    if(plot.delta0)
    {
      legend(legend.pos,legend=expression(delta==0),lty=2,col=2,bty="n",cex=lgd.cex) 
    }
  }
}

Try the macc package in your browser

Any scripts or data that you put into this service are public.

macc documentation built on May 2, 2019, 12:23 p.m.