Password protect(ish) your Shiny app


I have trawled through various blogs looking for ways in which to password protect my Shiny apps. As a self described ‘coding moron’, I have struggled with some of the more complicated suggestions. So I set out to find the simplest, cleanest solution to my password protection woes, and here it is:

Disclaimer: This is not designed to give you high level password protection. Anyone with advanced computer skills can easily circumnavigate this protection and view your app/data.


ui <- fluidPage(

  # Application title
  titlePanel("My password protected Shiny App"),

  # Sidebar with user input elements
      passwordInput("pwIn", "Passcode")


    # Show a plot

server <- function(input, output) {

  output$distPlot <- renderPlot({

    #This is essentially your password code snippet. The below graoh will not run
    #unless you type the password; test
      need(input$pwIn=="test", "Please enter the passcode"

    #Generate data and draw plot


#Run the application
shinyApp(ui = ui, server = server)


All about that base: some cool and useful functions for base plots and beyond


You’re either in the ggplot gang or the base plot gang. Despite what I joke to people about, I like ggplot, I have just plide my trade in base plot. Along the way, I have found some pretty useful snippets of code that are handy for base and to a lesser extent ggplot. I will be updating this sporadically when I come across more useful functions.

##Text and sequence manipulation
#Round up nice. Round up a sequence to the nearest 10.
roundUpNice = function(x, nice=c(1:10)) {
  if(length(x) != 1) stop("'x' must be of length 1")
  10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]]

#Wrapping strings. For when you have lengthly text that you automatically want to spread across
#multiple lines. The width argument determines where to cut the string.
wrap_strings = function(vector_of_strings,width){sapply(vector_of_strings,FUN=function(x){paste(strwrap(x,width=width), collapse="\n")})}
#e.g. wrap_strings(mytxext,width=15)
#If you have one line of text and want to split it up, then use the \n argument
txt = "Hugh Jackman\nis my bae"

#Orientating the x-axis to a given angle (and not just those set via las). The srt number defines
#the angle. Remember to put xpd =TRUE, so you can plot outside of the plotting area.
    srt = 50, adj= 1, xpd = TRUE,
    labels = names)

##Fine details
#Setting the transparency of colours. The second argument is the alpha level. 1 for non-transparent,
#0 for completely transparent

#This changes the height between text thats on 2 lines

#If all else fails and you want to make the graph in Excel,
#then this handy function should do the trick
write.excel <- function(x,row.names=FALSE,col.names=TRUE,...) {


Story time with papa Jamie


One cool R package I have been using lately, is ReporteRs. It essentially takes your plots etc and creates a PowerPoint of these. The quality of these are pretty good. This has been really useful for me, as I have been doing a lot of ‘data story boards’ for client presentations. Having a PowerPoint story board of all of my figures allows me to visualise what results I have, and what will be good for a client. If you’re a scientist writing a paper, this package will also come in handy as it will allow you to essentially create a PPT of your plots, diagnostics from these and even tables!

This is the final product here.

#Loading the package

#Create dummy variables

#Setting up an lm model

#Set your working directory

# Create a PowerPoint document. This is just an empty pptx doc at the moment
plots = pptx()

#Create your first slide. This will be a title slide
plots = addSlide(plots, "Section Header")
plots = addTitle(plots, "My storyline")

#Create a content slide
plots = addSlide(plots, "Title and Content")
plots = addTitle(plots, "Linear regression diagnostics")

#Wrap the plotting functions inside this wrapper.
#IMPORTANT. Anything you place in here such as functions,
#will not be avialable outside of it. So I suggest just placing
#the plotting stuff in here.
plotlm.diag= function(){
  #So we can have all of the plots on one page

  #Plotting the diagnostics

#This adds the plot to our empty plots Title and Content slide
plots = addPlot(plots, plotlm.diag,vector.graphic = T)
#Create a table output
plots = addSlide(plots, "Title and Content")
plots = addTitle(plots, "My lm output")

#The flextable output of the lm summary
plots = addFlexTable(plots, vanilla.table(data.frame("terms"=row.names(data.frame(summary(m)$coefficients)),
#Create another content slide
plots = addSlide(plots, "Title and Content")
plots = addTitle(plots, "My plot")

plot1= function(){
plots = addPlot(plots, plot1,vector.graphic = T)

####Create PPT
writeDoc(plots, file = "mystoryline.pptx")

Creating pretty dials

1 d3w3uiLunDng-Cuj6rEO-A

R can do a lot of things really really well, but one thing it struggles to do (at least in base R anyway) is to create pretty visuals. I have recently been creating visuals for some clients and wrote some code to produce some pretty dials in R. I will start by building a simple dial, and then adding various bits to it.

1.Simple dial

###Create a sequence from your breaks

###Creating the dial shape
get.poly <- function(a,b,r1=0.5,r2=1.0) {
 th.start <- pi*(1-a/100)
 th.end <- pi*(1-b/100)
 th <- seq(th.start,th.end,length=100)
 x <- c(r1*cos(th),rev(r2*cos(th)))
 y <- c(r1*sin(th),rev(r2*sin(th)))

###A nice big empty plotting area
###Dialling in the numbers
#Where you want the dial to finish

#The coloured section up to your position

#From your position to the end of the dial

Ta da! Here we have the output for the most simple of simple dials

1 On-eNjk5ksLXrlm5Q6fHHQ

Locator arrows in R


When creating advanced visualisations in R, determining the coordinates of where to put your arrows or text can be a tricky thing. Luckily, there is an awesome function in R called ‘locator‘.

##Make a plot

##Place locations of two arrows

##Once this line is run, the console run line should be flashing.
#click on a start and stop point of the where the first arrow should go,
##then the start and stop point on the second arrow.
##The console run line should then stop flashing

##run the loc.arrow line
##in this case
[1] 2.828149 2.798691 5.332089 7.070118
[1] 4.646730 8.367149 7.477484 4.201897

#Adding the arrows to the plot
with(loc.arrow, arrows(x0=x[seq(1,4,by=2)], x1=x[seq(2,4,by=2)],
y0=y[seq(1,4,by=2)], y1= y[seq(2,4,by=2)]))