Site icon R-bloggers

My first… web application with Shiny

Nicola Sturaro Sommacal

[This article was first published on Milano R net, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

It was several time I was thinking about developing a web application with R and Shiny.

In these days I realize my first application with Shiny. You can find it at http://spark.rstudio.com/nsturaro/pyramid0/

The idea is very simple: I plot a population pyramid for Italy. Data refers to year 2002 through 2011. Ages can be aggregated into classes, specifying the width of classes.

A Shiny application is defined by two R files: ui.R and server.R. As the names suggest, ui.R contains definition of the application interface, while server.R contains definition of the computation behind.

Let see the scripts.

ui.R contains the shiny package requirements and then call the shinyUI() function. Inside this function, the pageWithSidebar() function is used to specify which layout should be used. Finally, three elements are built, by just as many functions: headerPanel() contains the main title, sidebarPanel() defines the sidebar and mainPanel() defines the main content of the web page.

The sidebar panel contains two sliders and some custom HTML codes useful to put the company logo. The main panel contains only the plot.

This is the full code:

?Download ui.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

require(shiny)
 
shinyUI(pageWithSidebar(
 
  ###  Application title
  headerPanel("Italian population between 2002 and 2011"),
 
  ### Sidebar with sliders and HTML
  sidebarPanel(
    # Slider: choose class width
    sliderInput("ampiezza", "Class width (years):", min=1, max=10, value=5),
    # Slider: choose year
    sliderInput("anno", "Year:", min=2002, max=2011, value=2011, format = "0000", animate = TRUE), 
    # HTML info
    div(style = "margin-top: 30px; width: 200px; ", HTML("Developed by")),
    div(style = "margin-top: 10px; ", HTML("<a href='http://www.quantide.com'><img style='width: 150px;' src='http://www.quantide.com/images/quantide.png' /></a><img style='float: right; width: 150px;' src='http://www.nicolasturaro.name/logoWeb300.png' />")),
    div(style = "margin-top: 30px;", HTML("Source: <a href='http://demo.istat.it/'>ISTAT - Istituto Nazionale di Statistica</a>"))
  ),
 
  ### Main Panel
  mainPanel(
    # Show the plot
    plotOutput("pyramid", height="600px")
  )
))

On the other side, server.R contains the R code to produce the pyramid plot. Code that read input values and return output ought be wrapped in a function, contained in the shinyServer() function.

?Download server.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

# Load libraries
library(pyramid)
 
# Set working directory (to run code within RStudio)
#setwd("ShinyApps/pyramid")
 
# Load data
load("data.Rdata")
 
# Define useful functions
roundAny = function(x, accuracy, f = round) {f(x/accuracy) * accuracy}
 
 
 
### Main shinyServer function
shinyServer(function(input, output) {
 
  ### Plot output: pyramid
  output$pyramid <- renderPlot({
    # Define data column from slider input
    col = input$anno - 2002 + 1
 
    # Class widths from slider input
    agg = rep(1:1000, length.out = nrow(pop$MALES), each = input$ampiezza)
 
    # Build data frame with current year and class widths 
    df = data.frame(
      M = tapply(pop$MALES[, col], INDEX = agg, FUN = sum),
      F = tapply(pop$FEMALES[, col], INDEX = agg, FUN = sum)
    )
 
    # Given the class width, data frame with highest value
    dfMax = data.frame(
      M = tapply(pop$MALES[, ncol(pop$MALES)], INDEX = agg, FUN = sum),
      F = tapply(pop$FEMALES[, ncol(pop$FEMALES)], INDEX = agg, FUN = sum)
    )
 
    # Age classes labels
    lab = seq(from = 0, to = 1000, by = input$ampiezza)[1:nrow(df)]
 
    if(input$ampiezza == 1) {
      row.names(df) = lab
    } else {
      row.names(df) = paste(lab, lab+input$ampiezza-1, sep = " - ")
    }
    row.names(df)[nrow(df)] = paste0(lab[nrow(df)], "+")
 
    # Graphical parameter (adjusted for class width)
    val.Cadj = -0.01
    val.Cstep = 1
    if(input$ampiezza == 1) {val.Cadj = -0.030; val.Cstep = 3}
    if(input$ampiezza == 2) {val.Cadj = -0.025; val.Cstep = 2}
    if(input$ampiezza == 3) {val.Cadj = -0.020}
    if(input$ampiezza == 4) {val.Cadj = -0.015}
 
    # Data scale
    ord = nchar(max(dfMax)) - 1
    df = df/(10^ord)
    if(ord == 6) {val.Laxis = seq(0, roundAny(max(dfMax)/(10^ord), 0.5, ceiling), by = 0.5); val.main = "(millions)"}
    if(ord == 5) {val.Laxis = seq(0, roundAny(max(dfMax)/(10^ord), 1, ceiling), by = 1); val.main = "(thousands x 100)"}
 
    # Finally, draw the plot
    pyramid(df, Cstep = val.Cstep, Cadj = val.Cadj, AxisFM = "g", Laxis = val.Laxis, main = paste("Population", val.main))
 
  })
})

To leave a comment for the author, please follow the link and comment on their blog: Milano R net.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.