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.

RshinyIntro2
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.

This entry was posted by Matt Leonawicz.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: