## R sampling app version 2

Continuing from my previous post, Introducing R Shiny applications [app], here I expand upon the example Shiny app that was presented, which generates random samples from some common probability distributions. Specifically, I enhance the histogram plots of random samples from different probability distributions by adding the pdf (probability density function) for the currently selected distribution above the histogram. And, naturally, the pdf is not complete without specifying the support, so that is included as well.

You can click the image to go to the app page.

See my post, Mathematical Notation in R Plots, for some examples and conveniently supplied **R** code for displaying the equation of a pdf on an **R** plot for many common distributions. The code shown in this post for version 2 of the random sampling app will make use of all these **R** expressions, but you won’t see the expressions explicitly, so please see the other post if you are interested in how they work or just copying them for your convenience.

The first change is to simply add this line somewhere prior to the call to `shinyServer`

in the `server.R`

script:

`load("plotmathExpressions.RData", envir=.GlobalEnv)`

This workspace contains an expression object for each density function which will be used for annotating the histograms. They are loaded here because they only need to be loaded once. There is no reason to put them inside `shinyServer`

and have them redefined every time the user alters inputs in their browser. I choose to keep these in an `.RData`

file so that the `server.R`

script is not unnecessarily cluttered, but it is fine to define objects at the top of the `server.R`

script, as I’ve already done as well. Again, you can see the code for these expression objects at the notation post linked to above.

I chose to define these objects with names such as `expr.norm`

, `expr.t`

, `expr.gam`

, etc. This is convenient for grabbing the right expression based on the abbreviated object name for the currently selected distribution, as shown in the following code addition/change within `output$plot`

:

expr <- get(paste("expr",dist,sep=".")) par(mar=c(2,2,10,1)) hist(dat()[[1]],main=expr,xlab="Observations",col="orange",cex.main=1.5,cex.axis=1.2,cex.lab=1.2,prob=T)

I `get`

the appropriate expression. I increase the top margin to make sufficient room for plotting the expression – some of the more complex formulas need more vertical space than others, but it doesn’t look bad to leave the top margin fixed at `10`

for all distributions since the overall graphic is fairly basic. I’ve set the `main`

argument in `hist`

to `expr`

. And that’s that. The `ui.R`

script has not changed at all. Here is the complete `server.R`

script, version 2:

library(shiny) rt2 <- function(n=500,dft=15){ rt(n=n,df=dft) } formals(rgamma)[1:2] <- c(500,1) rchisq2 <- function(n=500,dfx=1){ rchisq(n=n,df=dfx) } formals(rf)[1:3] <- c(500,1,15) rexp2 <- function(n=500,rate2=1){ rexp(n=n,rate=rate2) } formals(rbeta)[1:3] <- c(500,2,2) load("plotmathExpressions.RData", envir=.GlobalEnv) shinyServer(function(input,output){ dat <- reactive({ dist <- switch(input$dist, norm=rnorm, unif=runif, t=rt2, F=rf, gam=rgamma, exp=rexp2, chisq=rchisq2, lnorm=rlnorm, beta=rbeta) def.args <- switch(input$dist, norm=c(input$mean,input$sd), unif=c(input$min,input$max), t=c(input$dft), F=c(input$df1,input$df2), gam=c(input$shape,input$rate), exp=c(input$rate2), chisq=c(input$dfx), lnorm=c(input$meanlog,input$sdlog), beta=c(input$shape1,input$shape2)) f <- formals(dist); f <- f[names(f)!="n"]; len <- min(length(f),3-1); f <- f[1:len] argList <- list(n=input$n) for(i in 1:len) argList[[names(f)[i]]] <- def.args[i] return(list(do.call(dist,argList),names(f))) }) output$dist1 <- renderUI({ lab <- switch(input$dist, norm="Mean:", unif="Minimum:", t="Degrees of freedom:", F="Numerator degrees of freedom:", gam="Shape:", exp="Rate:", chisq="Degrees of freedom:", lnorm="Mean(log):", beta="Alpha:") ini <- switch(input$dist, norm=0, unif=0, t=15, F=1, gam=1, exp=1, chisq=1, lnorm=0, beta=2) numericInput(dat()[[2]][1],lab,ini) }) output$dist2 <- renderUI({ lab <- switch(input$dist, norm="Standard deviation:", unif="Maximum:", F="Denominator degrees of freedom:", gam="Rate:", lnorm="Standard deviation(log)", beta="Beta:") ini <- switch(input$dist, norm=1, unif=1, F=15, gam=1, lnorm=1, beta=2) if(any(input$dist==c("norm","unif","F","gam","lnorm","beta"))) numericInput(dat()[[2]][2],lab,ini) }) output$dldat <- downloadHandler( filename = function() { paste(input$dist, '.csv', sep='') }, content = function(file) { write.csv(data.frame(x=dat()[[1]]), file) } ) output$plot <- renderPlot({ dist <- input$dist n <- input$n expr <- get(paste("expr",dist,sep=".")) par(mar=c(2,2,10,1)) hist(dat()[[1]],main=expr,xlab="Observations",col="orange",cex.main=1.5,cex.axis=1.2,cex.lab=1.2,prob=T) if(input$density) lines(density(dat()[[1]],adjust=input$bw),lwd=2) }) output$summary <- renderPrint({ summary(dat()[[1]]) }) output$table <- renderTable({ data.frame(x=dat()[[1]]) }) })

Go to version 2 of the sampling app. In my next post, R sampling app version 3 [app], I add more distributions to sample from, including discrete distributions. So in addition to pdf’s, there will be pmf’s (probability mass functions), and of course, with their supports included. I also have a follow up to my post, Mathematical notation in R plots, to include pmf’s as well to provide my flavor (for what it’s worth) of expression code for common discrete distributions.