inst/appdir/server.R

In BDP2: Bayesian Adaptive Designs for Phase II Trials with Binary Endpoint

function(input, output) {
    output$ProbSuccesses <- renderPlot({
      p0=input$p0
      p1=input$p1
      pF=input$pF
     shape1F=input$shape1F
      shape2F=input$shape2F
      n.range_1=as.numeric(input$n.range_1)

      par(mfrow=c(1,2))
      plotBDP2(x="n",y="Prob0Successes",n=c(n.range_1[1],n.range_1[2]),p0=p0,p1=p1)
      plotBDP2(x="n",y="PostProb0or1Successes",n=c(n.range_1[1],n.range_1[2]),pF=pF,shape1F=shape1F,shape2F=shape2F)
    })
    
    
    cE.vs.PEcall= reactive({
      pF=input$pF
      pE=input$pE
      p0=input$p0
      p1=input$p1
      shape1F=input$shape1F
      shape2F=input$shape2F
      shape1E=input$shape1E
      shape2E=input$shape2E

      cF=input$cF
      cE.range_1=as.numeric(input$cE.range_1)
      cEaccuracy=0.001
      cEvec=seq(from=cE.range_1[1],to=cE.range_1[2],by=cEaccuracy)
      interims.at= c(input$firstInterim.at,as.numeric(unlist(strsplit(input$furtherInterims.at," "))))
#     vn.int=input$firstInterim.at
      n=input$nfinal

      res=plotBDP2(x="cE",y="PEcall",n=n,interim.at=interims.at,pF=pF,cF=cF,pE=pE,cE=cEvec,p0=p0,p1=p1,
                   shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E,col=c("green","red"),cex.lab=1.4,show=FALSE)
      return(res)
  
    })
    
    
    output$cE.vs.PEcall <- renderPlot({
      plot.cE_vs_pEcall(cE.vs.PEcall())
      abline(v=input$cE,col="gray",lty="dashed")
    })

    output$OCs.selected.cE <- renderText({
      cE=input$cE
      res=cE.vs.PEcall()
      paste0("Selected cE leads to a type I error of ", round(res$y.p0[which.min(abs(res$x.p0-cE))[1]],3)," at p0=",input$p0,
             " and a power of ",round(res$y.p1[which.min(abs(res$x.p1-cE))[1]],3)," at p1=",input$p1,".")

    })


    output$n.vs.bFbE <- renderPlot({
      pF=input$pF
      pE=input$pE
      shape1F=input$shape1F
      shape2F=input$shape2F
      shape1E=input$shape1E
      shape2E=input$shape2E

      cF=input$cF
      cE=input$cE
      vn.int=input$firstInterim.at
      n=input$n.range_4[2]
      plotBDP2(x="n",y="bFbE",n=n,pF=pF,cF=cF,pE=pE,cE=cE,
                shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E,col=c("red","green"))
    })


    output$n.vs.PFstopEcall <- renderPlot({
      pF=input$pF
      pE=input$pE
      p0=input$p0
      p1=input$p1
      cF=input$cF
      cE=input$cE
      shape1F=input$shape1F
      shape2F=input$shape2F
      shape1E=input$shape1E
      shape2E=input$shape2E
      n.range_2=as.numeric(input$n.range_2)
        nvec=c(n.range_2[1]:n.range_2[2])
      interims.at= c(input$firstInterim.at,as.numeric(unlist(strsplit(input$furtherInterims.at," "))))

      par(mfrow=c(1,2))
      plotBDP2(x="n",y="PFstopEcall",n=nvec,interim.at=interims.at,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=p0,
                         shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E, progress=T,
               main="Type I error and probability of true stopping for varying n",cex.lab=1.4)
      plotBDP2(x="n",y="PFstopEcall",n=nvec,interim.at=interims.at,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=p1,
                         shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E,progress=T,
               main="Power and probability of false stopping for varying n",cex.lab=1.4,cex.legend = 1)
    })


    output$ptrue.vs.PEcall <- renderPlot({
      pF=input$pF
      pE=input$pE
      p0=input$p0
      p1=input$p1
      cF=input$cF
      cE=input$cE
      shape1F=input$shape1F
      shape2F=input$shape2F
      shape1E=input$shape1E
      shape2E=input$shape2E
      nvec= as.numeric(unlist(strsplit(input$nfinal.vec," ")))


      pvec=seq(input$ptrue.range_1[1],input$ptrue.range_1[2],by=.01)

      interims.at= c(input$firstInterim.at,as.numeric(unlist(strsplit(input$furtherInterims.at," "))))

      par(mfrow=c(1,2))
      # x="ptrue",y="PEcall"
        n=nvec[1]
        # vn.int=seq(0,n,by=input$interim.atEvery)[-1]
        # vn.int=vn.int[-length(vn.int)]
       vn.int=interims.at[interims.at<n]
        plotBDP2(x="ptrue",y="PEcall",n=n,interim.at=vn.int,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=pvec,
                          shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E,col=1,cex.lab=1.4)
        abline(v=p0,col="grey")
        abline(v=p1,col="grey")

        for (jj in 2:length(nvec)) {
          n=nvec[jj]
          # vn.int=seq(0,n,by=input$interim.atEvery)[-1]
          # vn.int=vn.int[-length(vn.int)]
        vn.int=interims.at[interims.at<n]
         plotBDP2(x="ptrue",y="PEcall",n=n,interim.at=vn.int,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=pvec,
                            shape1F=shape1F,shape2F=shape2F,shape1E=shape1E,shape2E=shape2E,add=TRUE,col=jj)

        }
        legend("bottomright",title="final analysis at ",legend=nvec,text.col = 1:length(nvec))

      # (x="ptrue",y="ExpectedNumber"
         n=nvec[1]
        # vn.int=seq(0,n,by=input$interim.atEvery)[-1]
        # vn.int=vn.int[-length(vn.int)]
        vn.int=interims.at[interims.at<n]
        plotBDP2(x="ptrue",y="ExpectedNumber",n=n,interim.at=vn.int,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=pvec,shape1F=shape1F,shape2F=shape2F,col=1,ylim=c(0,max(nvec)),cex.lab=1.4)
        abline(v=p0,col="grey")
        abline(v=p1,col="grey")

        for (jj in 2:length(nvec)) {
          n=nvec[jj]
          # vn.int=seq(0,n,by=input$interim.atEvery)[-1]
          # vn.int=vn.int[-length(vn.int)]
          vn.int=interims.at[interims.at<n]
          plotBDP2(x="ptrue",y="ExpectedNumber",n=n,interim.at=vn.int,pF=pF,cF=cF,pE=pE,cE=cE,ptrue=pvec,shape1F=shape1F,shape2F=shape2F,col=jj,add=TRUE)
        }
        legend("bottomright",title="final analysis at ",legend=nvec,text.col = 1:length(nvec))
    })


  output$report <- downloadHandler(
      # For PDF output, change this to "report.pdf"
       filename = function() {
      paste('report', sep = '.', switch(
        input$format, PDF = 'pdf', HTML = 'html', Word = 'docx'
      ))
},
      content = function(file) {
        # Copy the report file to a temporary directory before processing it, in
        # case we don't have write permissions to the current working dir (which
        # can happen when deployed).
        tempReport <- file.path(tempdir(), "report.Rmd")
      #  file.copy(paste0(normalizePath( find.package("BDP2"),winslash = "/"),"/exdata/report.Rmd"), tempReport, overwrite = TRUE)
        file.copy(file.path(system.file("appdir", package = "BDP2"), "report.Rmd"), tempReport, overwrite = TRUE)

        # Set up parameters to pass to Rmd document
        params <- list(
                        pF=input$pF,
                        pE=input$pE,
                        p0=input$p0,
                        p1=input$p1,
                        shape1F=input$shape1F,
                        shape2F=input$shape2F,
                        shape1E=input$shape1E,
                        shape2E=input$shape2E,
                        n.range_1=input$n.range_1,
                        n.range_2=input$n.range_2,
                        n.range_4=input$n.range_4,
                        cF=input$cF,
                        cE.range_1=input$cE.range_1,
                        cE=input$cE,
                        firstInterim.at=input$firstInterim.at,
                        furtherInterims.at=input$furtherInterims.at,
                        nfinal=input$nfinal,
                        nfinal.vec= input$nfinal.vec,
                        ptrue.range_1=input$ptrue.range_1
                      )

        # Knit the document, passing in the `params` list, and eval it in a
        # child of the global environment (this isolates the code in the document
        # from the code in this app).
        # render(tempReport, output_file = file,
        #   params = params,
        #   envir = new.env(parent = globalenv())
        # )
        out <- render(tempReport, switch(
        input$format,
        PDF = pdf_document(), HTML = html_document(), Word = word_document()
      ),params = params,
          envir = new.env(parent = globalenv())
      )
      file.rename(out, file)
      }
    )

}