Distribution Plotter

server.R

library(arm)
options(warn=-1)

shinyServer(function(input, output){


  Data <- reactive({
  #N <- as.numeric(input$ns)
  #prob <- input$prob
    lambda <- 0
    np1 <- 0
    ex=FALSE
    fxn <- fxe <- 1
    mu <- 0
    sigma2 <- 1
    xmaxe<-10
    xmaxn<-10
    prob <- 0
    
  if (input$whichdist == "binom"){
  prob <- input$p
  n <- input$n
  np1 <- n+1
  y <-  dbinom(c(0:np1), size=n, prob=prob)
  st1 <- bquote(paste("Number in sample of size ", .(n)))
  t1 <-  bquote( paste(pi== .(prob)))
  ex <- n*prob
  varx <- n*prob*(1-prob)
  x.d <- c(1,3,7,2,6,2,5,3,2,2,4,0,9,8,4,3,6,7,5,5,4,4,3,4) #lancet n=30
  vt1 <- bquote(paste("Var(x) is " ,.(varx)))
  }
  if (input$whichdist == "hyper"){
  n <- input$k
  np1 <- n+1
  Npop <- input$Npop
  Mpop <- input$Mpop
  y <- dhyper(c(0:np1), m=Mpop, n=Npop-Mpop, k=n)
  prob <- round( Mpop / (Npop),3)
  st1 <- bquote(paste("Number in sample of size ", .(n)))
  t1 <-  bquote( paste(pi== .(prob)))
  ex=n*prob
  x.d <- c(1,3,7,2,6,2,5,3,2,2,4,0,9,8,4,3,6,7,5,5,4,4,3,4) #lancet n=30
  varx <- n * (Mpop/Npop) * ((Npop-Mpop)/Npop) * ((Npop-n)/(Npop-1)) 
  vt1 <- bquote(paste("Var(x) is " ,.(varx)))
  

  
  }
  if (input$whichdist == "poisson"){
    n <- input$xmax
    np1 <- n+1
    lambda <- input$lambda
    y <- dpois(c(0:np1), lambda)
  st1 <- "x"  
  t1 <-  bquote( paste(lambda== .(lambda)))
  ex=lambda
  x.d <- c(rep(0,229), rep(1,211), rep(2,93), rep(3,35), rep(4,7),7)
  varx = lambda
  vt1 <- bquote(paste("Var(x) is " ,.(varx)))
  }
  
  
  
  if (input$whichdist == "expon"){
    lambda <- 1/input$theta
    ex <- lambda
    varx <- 1/input$theta^2
    n <- input$xmaxe
    x.d <- c(1,3,7,2,6,2,5,3,2,2,4,0,9,8,4,3,6,7,5,5,4,4,3,4) #lancet n=30
    vt1 <- bquote(paste("Var(x) is " ,.(varx)))
    fxe <- input$fxe
    y <- 0
    prob <- 0
    st1 <- 0
    t1 <-  bquote( paste(theta== .(1/lambda)))
    xmaxe <- input$xmaxe
    
  }
  
  if (input$whichdist == "normal"){
    mu <- input$mu
    ex <- mu
    sigma <- sqrt(input$sigma2)
    varx <- input$sigma2
    n <- input$xmaxn
    x.d <- c(1,3,7,2,6,2,5,3,2,2,4,0,9,8,4,3,6,7,5,5,4,4,3,4) #lancet n=30
    vt1 <- bquote(paste("Var(x) is " ,.(varx)))
    fxn <- input$fxn
    y <- 0
    prob <- 0
    st1 <- 0
    t1 <-  bquote( paste(mu== .(mu)))
    xmaxn <- input$xmaxn
  }
  
  
  ylims <- max(y)*1.2
  return(list(prob=prob, n=n, np1=np1, y=y, st1=st1,t1=t1,ex=ex,x.d=x.d,ylims=ylims, lambda=lambda, vt1=vt1, fxe=fxe, fxn=fxn, mu=mu,sigma=sigma,xmaxe=xmaxe,xmaxn=xmaxn))
  #
})
  
  
  output$basicfit <- renderPlot({
x.d <- Data()$x.d
t1 <- Data()$t1
st1 <- Data()$st1
ylims <- Data()$ylims
np1 <- Data()$np1
n <- Data()$n
xmaxe <- Data()$xmaxe
xmaxn <- Data()$xmaxn

if (input$whichdist == "expon" | input$whichdist == "normal"){
  if (input$whichdist == "expon"){
  fxe=Data()$fxe
  par(mfrow  = c(2,1))
  curve(dexp(x, 1/Data()$lambda), from = 0, to = n, ylab = "f(x)")
  polyspecx <- c(0,fxe, seq(fxe, 0, length=100))
  polyspecy <- c(0,0,dexp(polyspecx[-c(1:2)],1/Data()$lambda))
  polygon(polyspecx, polyspecy, col = "yellow")
curve(pexp(x, 1/Data()$lambda), from = 0, to = xmaxe, ylab = "F(x)")
points(fxe, pexp(fxe, 1/Data()$lambda), col = "red", pch = 16)
}else{
  fxn=Data()$fxn
  par(mfrow  = c(2,1))
  curve(dnorm(x, Data()$mu, Data()$sigma), from = -n, to = n, ylab = "f(x)")
  polyspecx <- c(-n,fxn, seq(fxn, -n, length=100))
  polyspecy <- c(0,0,dnorm(polyspecx[-c(1:2)],Data()$mu, Data()$sigma))
  polygon(polyspecx, polyspecy, col = "yellow")
  curve(pnorm(x, Data()$mu, Data()$sigma), from = -xmaxn, to = xmaxn, ylab = "F(x)")
  points(fxn, pnorm(fxn, Data()$mu, Data()$sigma), col = "red", pch = 16)
  
}
  
}else{
  par(mfrow  = c(2,1))
  if (input$withdata == TRUE){
  arm::discrete.histogram(x.d, freq = FALSE, main = t1, xlab = st1,  yaxt = "n", 
  ylim = c(0, ylims), xlim = c(-1,np1))  ### yaxs.label = "Prob(X=x)",
    }else{
  plot(c(0:n), rep(0.2, np1), type = "n", ylim = c(0, ylims), main = t1, ylab = "Prob[X=x]", 
       xlab = st1, bty = "n")
  }
  
  
  try(arrows(x0=c(0:Data()$n), y0=rep(0, Data()$np1), x1=c(0:Data()$n),  y1=Data()$y[1:Data()$np1], length = 0.1, col = "red", lwd = 2))
  text(c(0:Data()$n), Data()$y, round(Data()$y,3), cex = 0.5, pos=3)
  if (input$ex==TRUE) {abline(v=Data()$ex, col = "blue", lwd = 2, lty = 2)}
 # text(0,ylims,round(sum(dbinom(c(0:floor(N*prob)), N, prob) ),3), col = "blue")

cdf <- c(0, cumsum(Data()$y))
cdf.plot <- stepfun(-1:Data()$n, cdf, f=0)
plot.stepfun(cdf.plot, xlab="x", ylab = "F(x)", verticals=FALSE, do.points=TRUE, pch = 16, xlim=c(0,Data()$n), main = "")
 
}
})



output$varxplot <- renderPlot({
  
  varx <- Data()$varx
  ex <- Data()$ex
  vt1 <- Data()$vt1
  st1 <- Data()$st1
  ylims <- Data()$ylims
  np1 <- Data()$np1
  n <- Data()$n
  xmaxe <- Data()$xmaxe[1]
  xmaxn <- Data()$xmaxn[1]  
  
  if (input$whichdist == "expon" | input$whichdist == "normal"){
    if (input$whichdist == "expon"){
      xgrid <- seq(from = 0, to = xmaxe, length = 200)
      y2 <- (xgrid-ex)^2
      y2lims <- max(y2)
    }else{
      xgrid <- seq(from = -xmaxn, to = xmaxn, length = 200)
     y2 <- (xgrid-ex)^2
     y2lims <- max(y2)
    }
    
    plot(xgrid, y2, type = "l", xlab = "x", ylab = "(x-E[X])^2")
    }else{
  
  
  y2 <- (c(0:n)-ex)^2
  y2lims <- max(y2)
  plot(c(0:n), rep(0.2, np1), type = "n", ylim = c(0, y2lims), main = vt1, ylab = "(x-E[X])^2", xlab = st1, bty = "n")
  try(arrows(x0=c(0:n), y0=rep(0, np1), x1=c(0:n),  y1=y2[1:np1], length = 0.1, col = "salmon", lwd = 2))
  abline(v=ex, col = "blue", lwd = 2, lty = 2)   }
  
  
  
  
                           })

})

ui.R

shinyUI(fluidPage(
  titlePanel("Common Distributions"),
  
  sidebarLayout(
    sidebarPanel( "Choose a distribution",
                  selectInput("whichdist", "Which distribution", choices = c(Binomial="binom", Hypergeometric="hyper", Poisson="poisson", Exponential="expon", Normal="normal"), selected = "binom"),
                  checkboxInput("withdata", "With data?", value =FALSE),
                  
                  conditionalPanel(condition = "input.whichdist == 'binom'",
                  
                 
                  sliderInput("n", "",
                              min = 1, max = 100, value = c(30)),
                  sliderInput("p", "",
                              min = 0, max = 1, value = c(0.5)),
                  
                  checkboxInput("ex", "Show E[X]?", value =FALSE)
    ),
    conditionalPanel(condition = "input.whichdist == 'hyper'",
                     sliderInput("k", "", min = 1, max = 100, value = c(30)),
                     numericInput("Mpop", "M", value = 50, min = 0, max = 1000),
                     numericInput("Npop", "N", value = 250, min = 0, max = 10000),
                     
                     checkboxInput("ex", "Show E[X]?", value =FALSE)
    ),
                  
    
    conditionalPanel(condition = "input.whichdist == 'poisson'",
                     sliderInput("lambda", "lambda", value = 2.7, min = 0, max = 10, step = 0.01),
                     sliderInput("xmax", "Give up looking for infinity at: ", value = 20, min = 0, max = 100),
                     
                     checkboxInput("ex", "Show E[X]?", value =FALSE)
                     ),
  
    
    conditionalPanel(condition = "input.whichdist == 'expon'",
                     sliderInput("theta", "", min = 0, max = 2, step = 0.005, value = c(1)),
                     sliderInput("xmaxe", "Give up looking for infinity at: ", value = 20, min = 0, max = 50),
                     sliderInput("fxe", "Token x value: ", value = 1.5, min = 0.01, max = 5,step = 0.1),
                     checkboxInput("ex", "Show E[X]?", value =FALSE)
    ),
    conditionalPanel(condition = "input.whichdist == 'normal'",
                     sliderInput("mu", "", min = -10, max = 10, step = 0.1, value = c(0)),
                     sliderInput("sigma2", "", min = 0, max = 10, step = 0.1, value = c(1)),
                     sliderInput("xmaxn", "Give up looking for infinity at: ", value = 20, min = 0, max = 50),
                     sliderInput("fxn", "Token x value: ", value = 1.5, min = -5, max = 5,step = 0.1),
                     checkboxInput("ex", "Show E[X]?", value =FALSE)
    ),
    
    
    
    selectInput("showvar", "Show variance?", choices = c(yes="yes", no="no"), selected = "no")
    ),
     
    mainPanel("main panel",
    plotOutput('basicfit'),
    conditionalPanel(condition="input.showvar ==  'yes'",
    plotOutput('varxplot'))
)
    
)))