demo/PlottingTransformationFigures.R

In bpcp: Beta Product Confidence Procedure for Right Censored Data

## ----------------------------------------------------------------------------------------------------------
plotEstTrans<-function(b,tr,ngrid=100,...){
  theta1<- theta2<-seq(from=0,to=1,length.out=ngrid)
  Theta1<- rep(theta1,each=ngrid)
  Theta2<- rep(theta2,times=ngrid)
  Z<- tr(b(Theta1,Theta2))
  z<- t(matrix(Z,ngrid,ngrid,byrow=FALSE))
  out<-data.frame(theta1=Theta1,theta2=Theta2,z=Z)
  image(theta1,theta2,z, ...)
  contour(theta1,theta2,z,add=TRUE)
  #filled.contour(x=theta1,y=theta2,z,...)
  return(out)
}

## plot multiple panels on same graph
par(mfrow=c(2,3))


bdiff<-function(x,y){ y-x }
tdiff<-function(d){ d }
out<-plotEstTrans(bdiff,tdiff,ngrid=101,
                  #color.palette=cm.colors,
                  col=cm.colors(19),
      #levels=seq(from=-1,to=1,length.out=20),
      #xlab=expression(theta[1]),ylab=expression(theta[2]),
      xlab=expression(S[1](t)),ylab=expression(S[2](t)),
      main="Difference")

#dev.print(pdf,file="../tex/graphs/Bdifference.pdf")
## ----------------------------------------------------------------------------------------------------------
bratio<-function(x,y){
  R<- y/x 
  R[x==0 & y==0]<- 1
  R
}
tratio<-function(b){ 
   out<-(b-1)/(b+1)
   out[b==Inf]<- 1
   out
}

#tratio(bratio(0,1))
#tratio(bratio(1,0))


out<-plotEstTrans(bratio,tratio,ngrid=101,
                  #color.palette=cm.colors,
                  col=cm.colors(19),
      #levels=seq(from=-1,to=1,length.out=20),
      #xlab=expression(theta[1]),ylab=expression(theta[2]),
      xlab=expression(S[1](t)),ylab=expression(S[2](t)),
      main="Ratio")
#out

#dev.print(pdf,file="../tex/graphs/Bratio.pdf")




## ----------------------------------------------------------------------------------------------------------
bOR<-function(x,y){
  R<- (y*(1-x))/(x*(1-y)) 
  R[x==0 & y==0 | x==1 & y==1]<- 1
  R
}
tOR<-function(b){ 
   out<-(b-1)/(b+1)
   out[b==Inf]<- 1
   out
}

tOR(bOR(c(.01,.99),c(.99,.01)))
outOR<-plotEstTrans(bOR,tOR,ngrid=101,
                    #color.palette=cm.colors,
                    col=cm.colors(19),
      #levels=seq(from=-1,to=1,length.out=20),
      #xlab=expression(theta[1]),ylab=expression(theta[2]),
      xlab=expression(S[1](t)),ylab=expression(S[2](t)),
      main="Odds Ratio")

#dev.print(pdf,file="../tex/graphs/Boddsratio.pdf")


## ----------------------------------------------------------------------------------------------------------
bEffLT<-function(x,y){
  beta<- 1 - log(y)/log(x)
  beta[x==1 & y==1]<- 0
  beta[x==0 & y==0]<- 0
  beta[x==0 & y==1]<- 1
  # since lim_{x -> 1} 1/log(x) = -Inf
  # and log(y) < 0 for 0<y<1
  # whenver x==1 set beta to 1 - Inf = -Inf 
  beta[x==1]<- -Inf
  beta
}
tEffLT<-function(b){
  out<- b/(2-b)
  out[b==-Inf]<- -1
  out
}


#tEffLT(bEffLT(c(0,.1,.9,1),c(1,.9,.1,0)))

outLT<-plotEstTrans(bEffLT,tEffLT,ngrid=101,
                    #color.palette=cm.colors,
                    col=cm.colors(19),
      #levels=seq(from=-1,to=1,length.out=20),
      #xlab=expression(theta[1]),ylab=expression(theta[2]),
      xlab=expression(S[1](t)),ylab=expression(S[2](t)),
      main="Efficacy using log(S)")

#dev.print(pdf,file="../tex/graphs/Befflogtheta.pdf")

## ----------------------------------------------------------------------------------------------------------
bEffCDF<-function(x,y){
  beta<- 1 - (1-y)/(1-x)
  beta[x==1 & y==1]<- 0
  beta
}
tEffCDF<-function(b){
  out<- b/(2-b)
  out[b==-Inf]<- -1
  out
}


#tEffCDF(bEffCDF(c(0,.1,.9,1),c(1,.9,.1,0)))


outCDF<-plotEstTrans(bEffCDF,tEffCDF,ngrid=101,
                     #color.palette=cm.colors,
                     col=cm.colors(19),
      #levels=seq(from=-1,to=1,length.out=20),
      #xlab=expression(theta[1]),ylab=expression(theta[2]),
      xlab=expression(S[1](t)),ylab=expression(S[2](t)),
      main="Efficacy using 1-S")

#dev.print(pdf,file="../tex/graphs/BeffCDF.pdf")


#dev.print(pdf,file="../tex/biometrics/graphs/B5panels.pdf")