---
title: "Prob[+ve result is true +ve]"
author: |
   | Page 2: Proportion with effect ranges from 0 to 1.0
   | Page 3: Proportion ranges from 0 to 0.1
output: ioslides_presentation
runtime: shiny
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```
## `r tags$h3("Probability that detected effect is real (True +ve)")`
```{r ppv}
PPV <- function(Pmax=1.0, Pstep=.01)
{
  require(shiny)
shinyApp(
  ui=fluidPage(
     tags$style(type='text/css', ".selectize-input { font-size: 18px; line-height: 18px;} .selectize-dropdown { font-size: 15px; line-height:158px; }"),
    fluidRow(
      column(3, 
  selectInput("alpha", label = tags$div("α (0.05, or ...)", style="font-size: 20px"),
              choices = c(0.005, 0.02, 0.05), selected = 0.05)),
  column(2, 
  selectInput("power", label = tags$div("Power", style="font-size: 20px"),
              choices = c(0.25, 0.5, 0.8, 1), selected = 0.5)),
  column(7, 
  sliderInput("priorP", label = tags$div("Fraction with real effect", style="font-size: 20px"),
              min = 0, max = Pmax, value = 0.6, 
              step = if(Pmax>0.5)0.02 else 0.002, width='90%'))),
  plotOutput('ppvPlot')
),

server=function(input,output){
  output$ppvPlot <-
renderPlot({
  priorP <- input$priorP
  alpha=as.numeric(input$alpha)
  power <- as.numeric(input$power)
  falseY <- alpha * (1-priorP)
  trueY <- power * priorP
  vertmarks <- c(.975, .64, .85, .55, .225)
  par(mar=c(0.5,2.5,2.0, 2), lend=1, cex=2, xpd=TRUE)
  eps <- 0.005
  plot(0:(1+2*eps), 0:1, type='n', axes=FALSE, xlab="", ylab="")
  axis(3, at=c(0, 1-priorP), lwd=36, col='brown', tck=0,
       labels=FALSE, pos=1+0.025)
  axis(3, at=c(1-priorP+eps, 1+eps), lwd=36, col='blue', tck=0,
       labels=FALSE, pos=1+0.025)
  axis(3, tick=FALSE, at=c((1-priorP)/2, 1+eps-0.5*priorP),
       labels=c('Nothing to find (-ve)', 'Real effect (+ve)'), padj=0.5, adj=0.5)  
  labPre <- paste0(round(100*c(1-priorP, priorP)), "%")
  text((1-priorP)/2, rep(1.025,2), labels=labPre[1], col='white')  
  if(priorP >= 0.06) text(1+eps-0.5*priorP, 1.025, 
                          labels=labPre[2], col='white') else
                            text(1, 1.025, labels=labPre[2], pos=4, xpd=TRUE)
  arrows((1-priorP)/2, vertmarks[1], (1-priorP)/2, vertmarks[2])
  arrows(1+eps-0.5*priorP, vertmarks[1], 1+eps-0.5*priorP, vertmarks[2])
  text((1-priorP)/2-0.025, vertmarks[3], 
       substitute(" "%*% alpha*"\n ", list(alpha=alpha)), 
       adj=1, col="brown")
  text(1+eps-0.5*priorP-0.025, vertmarks[3], 
         substitute(" " %*% power*"\n ", list(power=power)), 
       adj=1, col="blue")
  text(c((1-priorP)/2-0.025, 1+eps-0.5*priorP-0.025), rep(vertmarks[3], 2), 
               c("\n\nFalse +ve", "\n\nTrue +ve"), 
       adj=1, col=c("brown", "blue"))
  postF <- (1-priorP)*alpha
  postT <- priorP*power
  axis(3, at=c(-postF/2, postF/2)+(1-priorP)/2, lwd=36, col='brown', tck=0,
       labels=FALSE, pos=vertmarks[4])
  axis(3, at=c(-postT/2, postT/2)+1+eps-0.5*priorP, lwd=36, col='blue', tck=0,
       labels=FALSE, pos=vertmarks[4])
labPost <- paste0(round(100*c(postF, postT),2), "%")
if(postT < 0.06)
text(c((1-priorP-postF)/2, 1+eps-0.5*(priorP+postT)), rep(vertmarks[4],2), 
     labels=labPost, pos=2)
else text((1-priorP-postF)/2, vertmarks[4], 
     labels=labPost[1], pos=2)
if(postT >= 0.06)text(1-priorP+eps+0.5*priorP, vertmarks[4], 
     labels=labPost[2], col='white')
ppv <- postT/(postF+postT)
postTtx <- paste(round(100*postT,2))
denomtx <- paste(round(100*c(postF,postT),2), collapse="+")
ppvtx <- paste(round(100*ppv,1))
expr <- substitute("Probability that detected effect is real = "*frac(postTtx, denomtx) == ppvtx*"%", 
                   list(postTtx=postTtx, denomtx=denomtx, ppvtx=ppvtx)) 
text(0.5, vertmarks[5], expr)
})
},
options=list(height=500)
)
}
PPV()
```

*******

```{r tryagain}
PPV(Pmax=0.1, Pstep=0.01)
```
