Build A Web Application Based on Shiny

Build A Web Application Based on Shiny

Now that I have three R packages published on CRAN, I want to make a small tool to monitor the downloads of these three R packages. The best way for me is to build a shiny-based web application. This tweet tells how to build this shiny application.

Glimpse



What’s shiny?

Shiny is an R package that makes it easy to build interactive web apps straight from R. You can host standalone apps on a webpage or embed them in R Markdown documents or build dashboards. You can also extend your Shiny apps with CSS themes, htmlwidgets, and JavaScript actions.

This introduction is from RStudio’s official website http://shiny.rstudio.com/. Every package I build contains a simple shiny application, For example, to start-up demo shiny application in ‘hchinamap’ package, you can run following R codes:

R
1
2
3
4
5
6
7
8
9
# Download chinadf data:
dir <- tempdir()
download.file('https://czxb.github.io/br/chinadf.rda', file.path(dir, 'chinadf.rda'))
load(file.path(dir, 'chinadf.rda'), verbose = TRUE)

# Running shiny app:
dir <- system.file("examples", "hchinamap", package = "hchinamap")
setwd(dir)
shiny::shinyAppDir(".")

This shiny application is very simple but include various input ways.

Get Started

Suppose you’re using RStudio. Fisrt, create a ‘Shiny Web Application’ project:

A typical shiny app consists of two parts, or functions, UI and Server. UI function defines the user interface and Server function responds the user’s actions.

This article will not elaborate on Shiny’s basic operations, which can be learned through the official website tutorials: Shiny-tutorial @ RStudio. A good news about Shiny is that Hadley Wickham is writing a book about shiny. You can go to Mastering Shiny @ GitHub to get the original version of the book.

Suppose you already have basic knowledge about shiny.

As for this project, I want to use a beautiful shiny template: argonDash @ Github.

Installation:

R
1
2
3
4
5
install.packages("argonR")
# devel version
devtools::install_github("RinteRface/argonDash")
# from CRAN
install.packages("argonDash")

Building Process

argonDash provides a complete demo which can be seen by running:

R
1
2
library(argonDash)
argonDashGallery()

You can build your own app with this example and its source code. Its source code can be found at:

R
1
2
system.file("examples", package = "argonDash")
#> [1] "/home/czxa/R/x86_64-pc-linux-gnu-library/3.4/argonDash/examples"

Design UI

A complete web page interface includes navigation bar, sidebar, body and footer:

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
# Load R Packages:
library(shiny)
library(argonR)
library(argonDash)
library(cranlogs)
library(dplyr)
library(jsonlite)
library(magrittr)
library(tibble)
library(tidyr)
library(billboarder)
library(RColorBrewer)
library(anytime)
# devtools::install_github("r-pkgs/gh")
library(gh)
library(purrr)

# Source additional R files:
source("sidebar.R")
source("navbar.R")
source("header.R")
source("footer.R")
source("cran_tabs.R")
source("github_tabs.R")

# UI
ui <- argonDashPage(
title = "CRAN & GitHub Monitor",
author = "czxa @ czxa.top",
description = "A shiny app for monitoring downloads of my R packages and Stars on GitHub",
sidebar = argonSidebar,
navbar = argonNav,
header = argonHeader,
body = argonDashBody(
argonTabItems(
cran_tabs,
github_tabs
)
),
footer = argonFooter
)

This UI function looks quite simple, that was because I split most of the code into other R files.

sidebar.R defines the composition of the sidebar:

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
argonSidebar <- argonDashSidebar(
vertical = TRUE,
skin = "light",
background = "white",
size = "md",
side = "left",
id = "my_sidebar",
brand_url = "https://czxa.top",
brand_logo = "https://czxa.top/images/painter.svg",
argonSidebarHeader(title = "Monitor Iterm"),
argonSidebarMenu(
argonSidebarItem(
tabName = "downloads",
icon = "pin-3",
"CRAN"
),
argonSidebarItem(
tabName = "stars",
icon = "credit-card",
"GitHub"
)
),
argonSidebarDivider(),
argonSidebarHeader(title = "Adding...")
)

The tabName parameters are what you need to focus on. They should correspond exactly to the tabName given in argonTabItems.

navbar.R defines the composition of the navigation bar, a drop-down list:

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
argonNav <- argonDashNavbar(
argonDropNav(
title = "My Website Entrance",
src = "https://czxa.top/images/pad.svg",
orientation = "right",
argonDropNavTitle(title = "Welcome!"),
argonDropNavItem(
title = "Home",
src = "https://czxa.top",
icon = "single-02"
),
argonDropNavItem(
title = "Archive",
src = "https://czxa.top/archives",
icon = "bullet-list-67"
),
argonDropNavItem(
title = "About",
src = "https://czxa.top/about",
icon = "settings-gear-65"
),
argonDropNavItem(
title = "Mail to me",
src = "mailto:[email protected]",
icon = "planet"
)
)
)

header.R:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
argonHeader = argonDashHeader(
gradient = TRUE,
color = "primary",
separator = TRUE,
separator_color = "secondary",
argonCard(
title = "CRAN & GITHUB MONITOR",
src = "https://czxa.top",
hover_lift = TRUE,
shadow = TRUE,
shadow_size = NULL,
hover_shadow = FALSE,
border_level = 0,
icon = "atom",
status = "primary",
background_color = NULL,
gradient = FALSE,
floating = FALSE,
"A shiny app for monitoring downloads of my R packages and Stars on GitHub"
)
)

Just a ‘argonCard’ with some text on it.

footer.R is also very simple:

R
1
2
3
4
5
6
7
argonFooter <- argonDashFooter(
copyrights = "©czxa.top 2019",
src = "https://czxa.top",
argonFooterMenu(
argonFooterItem("@GitHub", src = "https://github.com/czxa")
)
)

The body part consists of two parts coresponding to two tabName defined in sidebar.R:

cran_tabs.R:

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
# New Function
argonInfoCard2 <- function(value, title = NULL, stat = NULL, stat_icon = NULL,
description = NULL, icon, icon_background = NULL, hover_lift = FALSE,
shadow = FALSE, background_color = NULL, gradient = FALSE,
width = 3){
iconCl <- "icon icon-shape text-white rounded-circle shadow"
if (!is.null(icon_background))
iconCl <- paste0(iconCl, " bg-", icon_background)
cardCl <- "card card-stats mb-4 mb-xl-0"
if (hover_lift)
cardCl <- paste0(cardCl, " card-lift--hover")
if (shadow)
cardCl <- paste0(cardCl, " shadow")
if (gradient) {
if (!is.null(background_color))
cardCl <- paste0(cardCl, " bg-gradient-", background_color)
}
else {
if (!is.null(background_color))
cardCl <- paste0(cardCl, " bg-", background_color)
}
if (!is.null(background_color))
if (background_color == "default")
text_color <- "text-white"
else text_color <- NULL
else text_color <- NULL
statCl <- if (stat > 0)
"text-success mr-2"
else "text-danger mr-2"
infoCardTag <- shiny::tags$div(class = cardCl,
shiny::tags$div(class = "card-body",
shiny::fluidRow(argonR::argonColumn(
shiny::tags$h5(class = paste0("card-title text-uppercase mb-0 ",
text_color), title),
shiny::span(class = paste0("h2 font-weight-bold mb-0 ",
text_color), value)), shiny::tags$div(class = "col-auto",
shiny::tags$div(class = iconCl, shiny::tags$i(class = paste0("fas fa-",
icon))))), shiny::p(class = "mt-3 mb-0 text-sm",
shiny::span(class = statCl, shiny::icon(stat_icon),
paste0(stat, "")), shiny::span(class = paste0("h5 ",
text_color), description))))
argonR::argonColumn(width = width, infoCardTag)
}

cran_tabs <- argonTabItem(
tabName = "downloads",

# info cards
argonRow(
argonInfoCard2(
value = textOutput("total_downloads"),
title = "Total Downloads",
stat = 3,
stat_icon = "arrow-up",
icon = "chart-bar",
icon_background = "danger",
hover_lift = TRUE,
description = "Packages on CRAN",
width = 4
),
argonInfoCard2(
value = textOutput("last_month_downloads"),
title = "Last Month",
stat = 3,
stat_icon = "arrow-up",
icon = "chart-pie",
icon_background = "warning",
shadow = TRUE,
description = " New Packages Submitted",
hover_lift = TRUE,
width = 4
),
argonInfoCard2(
value = textOutput("last_week_downloads"),
title = "Last Week",
stat_icon = "arrow-up",
icon = "chart-line",
icon_background = "primary",
stat = 1,
description = " New Packages Submitted",
hover_lift = TRUE,
width = 4
)
),
br(),

# CRAN DOWNLOADS
argonRow(
argonCard(
width = 12,
src = NULL,
icon = "ui-04",
status = "success",
shadow = TRUE,
border_level = 2,
hover_shadow = TRUE,
title = "CRAN DOWNLOADS",
argonRow(
argonColumn(width = 12, withSpinner(billboarderOutput("cran_downloads")))
)
)
)
)

I made a minor adjustment to the argonInfoCard function and named it argonInfoCard2, mainly by deleting a percentage sign from it. At first, Initially, I wanted to use the highcharter package to plot. But I found that the use of the highcharter package would affect the layout of the site, so I later switched to the billboarder package. Note that the tabName(tabName = "downloads") here corresponds to the tabName mentioned above in the sidebar section.

Pay attention to billboarderOutput("cran_downloads"), *Output() and render*() are pairs of functions., *Output() is used in UI functions while render*() is used in Server functions. “cran_downloads” is the id, which acts as a link between *Output() and render*().

github_tabs.R is similar with cran_tabs.R:

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
github_tabs <- argonTabItem(
tabName = "stars",
argonRow(
argonInfoCard2(
value = textOutput("total_stars"),
title = "Total Stars",
stat = 22,
stat_icon = "arrow-up",
icon = "chart-pie",
icon_background = "danger",
hover_lift = TRUE,
description = "Repos on GitHub",
width = 4
),
argonInfoCard2(
value = textOutput("total_forks"),
title = "Total Forks",
stat = 22,
stat_icon = "arrow-up",
icon = "chart-line",
icon_background = "warning",
shadow = TRUE,
description = "Repos on GitHub",
hover_lift = TRUE,
width = 4
),
argonInfoCard2(
value = textOutput("followers"),
title = "Total Followers",
stat_icon = "arrow-up",
icon = "chart-bar",
icon_background = "primary",
stat = 22,
description = "Repos on GitHub",
hover_lift = TRUE,
width = 4
)
),
br(), br(),

# GitHub
argonH1("GITHUB STARS", display = 4),
argonRow(
argonCard(
width = 12,
src = NULL,
icon = "spaceship",
status = "success",
shadow = TRUE,
border_level = 2,
hover_shadow = TRUE,
title = "GITHUB STARS",
argonRow(
argonColumn(width = 12, withSpinner(billboarderOutput("github_stars")))
)
)
)
)

Backend: Server function

Shiny web applications use R as backend. In summary, we define the following in the UI section:

  1. textOutput(“total_downloads”)
  2. textOutput(“last_month_downloads”)
  3. textOutput(“last_week_downloads”)
  4. billboarderOutput(“cran_downloads”)
  5. textOutput(“total_stars”)
  6. textOutput(“total_forks”)
  7. textOutput(“followers”)
  8. billboarderOutput(“github_stars”)

Next, we need to program some render*() correspond them:

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
server = function(input, output) {
# Get CRAN data
crandf <- reactive({
cran_downloads(
c("hwordcloud", "hpackedbubble", "hchinamap"),
from = "2019-08-07",
to = "last-day") %>%
as_tibble()
})
# CRAN downloads curve
output$cran_downloads <- renderBillboarder({
billboarder() %>%
bb_linechart(
data = crandf(),
type = "spline",
mapping = bbaes(x = date, y = count, group = package)
) %>%
bb_x_axis(tick = list(format = "%Y-%m-%d", fit = FALSE)) %>%
bb_x_grid(show = TRUE) %>%
bb_y_grid(show = TRUE) %>%
bb_color(palette = c("#5e72e4", "#2dce89", "#f5365c")) %>%
bb_legend(position = "right") %>%
bb_subchart(show = TRUE, size = list(height = 30)) %>%
bb_labs(title = "My R Packages on CRAN",
y = "Downloads",
caption = "Data source: https://cran.r-project.org/")
})
# CRAN Total Downloads
output$total_downloads <- renderText({
crandf() %>%
summarise(total = sum(count)) %>%
.[1,1] %>%
as.character()
})

# Last Month Downloads
output$last_month_downloads <- renderText({
cran_downloads(packages = c("hwordcloud", "hpackedbubble", "hchinamap"),
when = "last-month") %>%
summarise(sum(count)) %>%
.[1,1] %>%
as.character()
})

# Last Week Downloads
output$last_week_downloads <- renderText({
cran_downloads(packages = c("hwordcloud", "hpackedbubble", "hchinamap"),
when = "last-week") %>%
summarise(sum(count)) %>%
.[1,1] %>%
as.character()
})

# GitHub Stars
USER <- "czxa"
user <- gh("/users/:user", user=USER)
repos <- gh("/users/:user/repos", user=USER, .limit = Inf)
repos_df <- map_df(repos, ~.[c("name", "html_url", "stargazers_count", "forks_count", "updated_at", "pushed_at")]) %>%
mutate(updated_at = anytime(pushed_at, asUTC=TRUE), pushed_at = NULL) %>%
arrange(-stargazers_count)
output$github_stars <- renderBillboarder({
billboarder() %>%
bb_barchart(data = repos_df[1:10,],
mapping = bbaes(x = name, y = stargazers_count)) %>%
bb_color(palette = c("#5e72e4")) %>%
bb_legend(show = F) %>%
bb_x_grid(show = TRUE) %>%
bb_y_grid(show = TRUE) %>%
bb_labs(title = "Top 10 Repository on My GitHub @ czxa",
y = "Stars",
caption = "Data source: https://github.com/czxa")
})
output$total_stars <- renderText({
repos_df %>%
summarise(total = sum(stargazers_count)) %>%
as.character()
})

# total followers
githubjson <- reactive({
read_json("https://api.github.com/users/czxa")
})
output$followers <- renderText({
githubjson()$followers
})

# total forks
output$total_forks <- renderText({
repos_df %>%
summarise(total = sum(forks_count)) %>%
as.character()
})
}

Note that I use the reactive function in the following code:

R
1
2
3
4
5
6
7
crandf <- reactive({
cran_downloads(
c("hwordcloud", "hpackedbubble", "hchinamap"),
from = "2019-08-07",
to = "last-day") %>%
as_tibble()
})

In fact, it’s unnecessary. Reactive programming means the ouputs are reactive to the input parameters, but I didn’t set input parameter here.

In Shiny, you express your server logic using reactive programming. Reactive programming is an elegant and powerful programming paradigm, but it can be disorienting at first because it’s a very different paradigm to writing a script. The key idea of reactive programming is to specify a graph of dependencies so that when an input changes, all outputs are automatically updated. This makes the flow of an app considerably simpler, but it takes a while to get your head around how it all fits together. —— Mastering Shiny

Just as a example, the core codes of CRAN downloads curve is:

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
crandf <- cran_downloads(
c("hwordcloud", "hpackedbubble", "hchinamap"),
from = "2019-08-07",
to = "last-day") %>%
as_tibble()
billboarder() %>%
bb_linechart(
data = crandf,
type = "spline",
mapping = bbaes(x = date, y = count, group = package)
) %>%
bb_x_axis(tick = list(format = "%Y-%m-%d", fit = FALSE)) %>%
bb_x_grid(show = TRUE) %>%
bb_y_grid(show = TRUE) %>%
bb_color(palette = c("#5e72e4", "#2dce89", "#f5365c")) %>%
bb_legend(position = "right") %>%
bb_subchart(show = TRUE, size = list(height = 30)) %>%
bb_labs(title = "My R Packages on CRAN",
y = "Downloads",
caption = "Data source: https://cran.r-project.org/")

You can learn billboarder at dreamRs/billboarder.

Many R packages were used in the process of writing the Server function above. For examples, cranlogs package is used to obtain CRAN downloads data, gh package is used to get my GitHub repositories’ data, jsonlite is used to process data in JSON format…

Because this application needs to get data from the Internet, charts and data load slowly when the network speed is slow. In order to make the waiting process less boring, we can add loader animations to Shiny Outputs, shinycssloaders package can do this thing. First, install it from GitHub:

R
1
devtools::install_github('andrewsali/shinycssloaders')

Load it and put billboarderOutput() in withSpinner(), or you can use billboarderOutput() %>% withSpinner().

Deploy

‘shinyapps.io’ allows you to deploy five shinyapps for free. It seems that I have one quota left. Next, I’ll deploy this shiny application on it.

I just need to open https://czxa.shinyapps.io/monitoring to know the total download of my R packages and some information on GitHub.

unsplash-logoChapman Chow

# R

Comments

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×