18
Jun

Create Infographics with R

This tutorial explains how to create charts used for Infographics in R. The word Infographics is made up of two words Information and Graphics. It simply means graphical visual representation of information. They are visually appealing and attracts attention of audience. In presentations, it adds WOW factor and makes you stand out in a crowd.
Install the packages used for Infographic Charts
You can install these packages by running command install.packages(). The package echarts4r.assets is not available on CRAN so you need to install it from github account by running this command devtools::install_github("JohnCoene/echarts4r.assets")
  1. waffle
  2. extrafont
  3. tidyverse
  4. echarts4r
  5. echarts4r.assets

Waffle (Square Pie Chart)

In this section we will see how to create waffle chart in R. Waffle charts are also known as square pie or matrix charts. They show distribution of a categorical variable. It's an alternative to pie chart. It should be used when number of categories are less than 4. Higher the number of categories, more difficult would be read this chart. In the following example, we are showing percentage of respondents who answered 'yes' or 'no' in a survey.

library(waffle)
waffle(
c('Yes=70%' = 70, 'No=30%' = 30), rows = 10, colors = c("#FD6F6F", "#93FB98"),
title = 'Responses', legend_pos="bottom"
)
waffle in r
Use Icon in Waffle
Steps to download and install fontawesome fonts
  1. First step is to load extrafont library by running this command library(extrafont)
  2. Download and install fontawesome fonts from this URL https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/fonts/fontawesome-webfont.ttf
  3. Import downloaded fontawesome font by using this command. Make sure to specify your folder location containing fontawesome.extrafont::font_import (path="C:\\Users\\DELL\\Downloads", pattern = "awesome", prompt = FALSE)
  4. Load fonts by using the command loadfonts(device = "win")
  5. Check whether font awesome is installed successfully by running this command fonts()[grep("Awesome", fonts())]. It should return FontAwesome
In the example below, we are showing performance of girls in a particular subject. The option use_glyph= refers to icon you want to show in the chart and glyph_size= refers to size of the icon.

waffle(
c(`Poor=10` =10, `Average=18` = 18, `Excellent=7` =7), rows = 5, colors = c("#FD6F6F", "#93FB98", "#D5D9DD"),
use_glyph = "female", glyph_size = 12 ,title = 'Girls Performance', legend_pos="bottom"
)
waffle icon
How to align multiple waffle charts
By using iron( ) function you can left-align waffle plots. You can use ggplot2 functions to customize the plot (like I did in the program below to center align the title using plot.title = )

iron(
waffle(
c('TRUE' = 7, 'FALSE' = 3),
colors = c("pink", "grey70"),
use_glyph = "female",
glyph_size = 12,
title = "Female vs Male",
rows = 1,
legend_pos = "none"
) + theme(plot.title = element_text(hjust = 0.5))
,
waffle(
c('TRUE' = 8, 'FALSE' = 2),
colors = c("skyblue", "grey70"),
use_glyph = "male",
glyph_size = 12,
rows = 1,
legend_pos = "none"
)
)
multiple waffle plots

Pictorial Charts in R

Pictorial charts show data scaled in picture or image form instead of bars or columns. They are also called pictogram charts. Let's create fake data for illustrative purpose.

df22 <- data.frame(
x = sort(LETTERS[1:5], decreasing = TRUE),
y = sort(sample(20:80,5))
)

x y
1 E 27
2 D 29
3 C 45
4 B 46
5 A 78
e_pictorial(value, symbol) function is used for pictorial plots. The second parameter symbol refers to built-in symbols like circle, rect, roundRect, triangle, diamond, pin, arrow, icon, images and SVG Path. Built-in symbols can be used like symbol = "rect"

library(echarts4r)
library(echarts4r.assets)

df22 %>%
e_charts(x) %>%
e_pictorial(y, symbol = ea_icons("user"),
symbolRepeat = TRUE, z = -1,
symbolSize = c(20, 20)) %>%
e_theme("westeros") %>%
e_title("People Icons") %>%
e_flip_coords() %>%
# Hide Legend
e_legend(show = FALSE) %>%
# Remove Gridlines
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(splitLine=list(show = FALSE)) %>%
# Format Label
e_labels(fontSize = 16, fontWeight ='bold', position = "right", offset=c(10, 0))
Add Images in Chart
If you are using images, make sure to precede it with image:// before image address. In the code below, we have used paste0( ) function to concatenate it before image address.

Unity <- "https://im.rediff.com/news/2018/oct/29statue-of-unity.png"
Buddha <-"http://im.rediff.com/news/2018/oct/29spring-temple-buddha-china.png"

data <- data.frame(
x = c("Statue of Unity", "Spring Temple Buddha"),
value = c(182, 129),
symbol = c(paste0("image://", Unity),
paste0("image://", Buddha))
)

data %>%
e_charts(x) %>%
e_pictorial(value, symbol) %>%
e_theme("westeros") %>%
e_legend(FALSE) %>%
# Title Alignment
e_title("Statues Height", left='center', padding=10) %>%
e_labels(show=TRUE) %>%
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(show=FALSE, min=0,max=200, interval=20, splitLine=list(show = FALSE))
Pencil Chart in R
Instead of bars, we are using pencil to show comparison of values.

df02 <- data.frame(
x = LETTERS[1:10],
y = sort(sample(10:80,10), decreasing = TRUE)
)

df02 %>%
e_charts(x) %>%
e_pictorial(y, symbol = paste0("image://","https://1.bp.blogspot.com/-klwxpFekdEQ/XOubIhkalyI/AAAAAAAAHlE/25psl9x4oNkbJoLc2CKTXgV2pEj6tAvigCLcBGAs/s1600/pencil.png")) %>%
e_theme("westeros") %>%
e_title("Pencil Chart", padding=c(10,0,0,50))%>%
e_labels(show = TRUE)%>%
e_legend(show = FALSE) %>%
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(show=FALSE, splitLine=list(show = FALSE))

Fill Male, Female Icons based on percentage

To find SVG Path, download desired SVG file from https://iconmonstr.com/ and open it in chrome and then find path in page source.

gender = data.frame(gender=c("Male", "Female"), value=c(65, 35),
path = c('path://M18.2629891,11.7131596 L6.8091608,11.7131596 C1.6685112,11.7131596 0,13.032145 0,18.6237673 L0,34.9928467 C0,38.1719847 4.28388932,38.1719847 4.28388932,34.9928467 L4.65591984,20.0216948 L5.74941883,20.0216948 L5.74941883,61.000787 C5.74941883,65.2508314 11.5891201,65.1268798 11.5891201,61.000787 L11.9611506,37.2137775 L13.1110872,37.2137775 L13.4831177,61.000787 C13.4831177,65.1268798 19.3114787,65.2508314 19.3114787,61.000787 L19.3114787,20.0216948 L20.4162301,20.0216948 L20.7882606,34.9928467 C20.7882606,38.1719847 25.0721499,38.1719847 25.0721499,34.9928467 L25.0721499,18.6237673 C25.0721499,13.032145 23.4038145,11.7131596 18.2629891,11.7131596 M12.5361629,1.11022302e-13 C15.4784742,1.11022302e-13 17.8684539,2.38997966 17.8684539,5.33237894 C17.8684539,8.27469031 15.4784742,10.66467 12.5361629,10.66467 C9.59376358,10.66467 7.20378392,8.27469031 7.20378392,5.33237894 C7.20378392,2.38997966 9.59376358,1.11022302e-13 12.5361629,1.11022302e-13',
'path://M28.9624207,31.5315864 L24.4142575,16.4793596 C23.5227152,13.8063773 20.8817445,11.7111088 17.0107398,11.7111088 L12.112691,11.7111088 C8.24168636,11.7111088 5.60080331,13.8064652 4.70917331,16.4793596 L0.149791395,31.5315864 C-0.786976655,34.7595013 2.9373074,35.9147532 3.9192135,32.890727 L8.72689855,19.1296485 L9.2799493,19.1296485 C9.2799493,19.1296485 2.95992025,43.7750224 2.70031069,44.6924335 C2.56498417,45.1567684 2.74553639,45.4852068 3.24205501,45.4852068 L8.704461,45.4852068 L8.704461,61.6700801 C8.704461,64.9659872 13.625035,64.9659872 13.625035,61.6700801 L13.625035,45.360657 L15.5097899,45.360657 L15.4984835,61.6700801 C15.4984835,64.9659872 20.4191451,64.9659872 20.4191451,61.6700801 L20.4191451,45.4852068 L25.8814635,45.4852068 C26.3667633,45.4852068 26.5586219,45.1567684 26.4345142,44.6924335 C26.1636859,43.7750224 19.8436568,19.1296485 19.8436568,19.1296485 L20.3966199,19.1296485 L25.2043926,32.890727 C26.1862111,35.9147532 29.9105828,34.7595013 28.9625083,31.5315864 L28.9624207,31.5315864 Z M14.5617154,0 C17.4960397,0 19.8773132,2.3898427 19.8773132,5.33453001 C19.8773132,8.27930527 17.4960397,10.66906 14.5617154,10.66906 C11.6274788,10.66906 9.24611767,8.27930527 9.24611767,5.33453001 C9.24611767,2.3898427 11.6274788,0 14.5617154,0 L14.5617154,0 Z'))

gender %>%
e_charts(gender) %>%
e_x_axis(splitLine=list(show = FALSE),
axisTick=list(show=FALSE),
axisLine=list(show=FALSE),
axisLabel= list(show=FALSE)) %>%
e_y_axis(max=100,
splitLine=list(show = FALSE),
axisTick=list(show=FALSE),
axisLine=list(show=FALSE),
axisLabel=list(show=FALSE)) %>%
e_color(color = c('#69cce6','#eee')) %>%
e_pictorial(value, symbol = path, z=10, name= 'realValue',
symbolBoundingData= 100, symbolClip= TRUE) %>%
e_pictorial(value, symbol = path, name= 'background',
symbolBoundingData= 100) %>%
e_labels(position = "bottom", offset= c(0, 10),
textStyle =list(fontSize= 20, fontFamily= 'Arial',
fontWeight ='bold',
color= '#69cce6'),
formatter="{@[1]}% {@[0]}") %>%
e_legend(show = FALSE) %>%
e_theme("westeros")

Show icon as label in plot

In label =, mention unicode of the fontawesome icon.

library(ggplot2)
ggplot (mtcars) +
geom_text( aes ( mpg , wt , colour = factor ( cyl )),
label = "\uf1b9" ,
family = "FontAwesome" ,
size = 7)
18
Jun

Create Infographics with R

This tutorial explains how to create charts used for Infographics in R. The word Infographics is made up of two words Information and Graphics. It simply means graphical visual representation of information. They are visually appealing and attracts attention of audience. In presentations, it adds WOW factor and makes you stand out in a crowd.
Install the packages used for Infographic Charts
You can install these packages by running command install.packages(). The package echarts4r.assets is not available on CRAN so you need to install it from github account by running this command devtools::install_github("JohnCoene/echarts4r.assets")
  1. waffle
  2. extrafont
  3. tidyverse
  4. echarts4r
  5. echarts4r.assets

Waffle (Square Pie Chart)

In this section we will see how to create waffle chart in R. Waffle charts are also known as square pie or matrix charts. They show distribution of a categorical variable. It's an alternative to pie chart. It should be used when number of categories are less than 4. Higher the number of categories, more difficult would be read this chart. In the following example, we are showing percentage of respondents who answered 'yes' or 'no' in a survey.

library(waffle)
waffle(
c('Yes=70%' = 70, 'No=30%' = 30), rows = 10, colors = c("#FD6F6F", "#93FB98"),
title = 'Responses', legend_pos="bottom"
)
waffle in r
Use Icon in Waffle
Steps to download and install fontawesome fonts
  1. First step is to load extrafont library by running this command library(extrafont)
  2. Download and install fontawesome fonts from this URL https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/fonts/fontawesome-webfont.ttf
  3. Import downloaded fontawesome font by using this command. Make sure to specify your folder location containing fontawesome.extrafont::font_import (path="C:\Users\DELL\Downloads", pattern = "awesome", prompt = FALSE)
  4. Load fonts by using the command loadfonts(device = "win")
  5. Check whether font awesome is installed successfully by running this command fonts()[grep("Awesome", fonts())]. It should return FontAwesome
In the example below, we are showing performance of girls in a particular subject. The option use_glyph= refers to icon you want to show in the chart and glyph_size= refers to size of the icon.

waffle(
c(`Poor=10` =10, `Average=18` = 18, `Excellent=7` =7), rows = 5, colors = c("#FD6F6F", "#93FB98", "#D5D9DD"),
use_glyph = "female", glyph_size = 12 ,title = 'Girls Performance', legend_pos="bottom"
)
waffle icon
How to align multiple waffle charts
By using iron( ) function you can left-align waffle plots. You can use ggplot2 functions to customize the plot (like I did in the program below to center align the title using plot.title = )

iron(
waffle(
c('TRUE' = 7, 'FALSE' = 3),
colors = c("pink", "grey70"),
use_glyph = "female",
glyph_size = 12,
title = "Female vs Male",
rows = 1,
legend_pos = "none"
) + theme(plot.title = element_text(hjust = 0.5))
,
waffle(
c('TRUE' = 8, 'FALSE' = 2),
colors = c("skyblue", "grey70"),
use_glyph = "male",
glyph_size = 12,
rows = 1,
legend_pos = "none"
)
)
multiple waffle plots

Pictorial Charts in R

Pictorial charts show data scaled in picture or image form instead of bars or columns. They are also called pictogram charts. Let's create fake data for illustrative purpose.

df22 <- data.frame(
x = sort(LETTERS[1:5], decreasing = TRUE),
y = sort(sample(20:80,5))
)

x y
1 E 27
2 D 29
3 C 45
4 B 46
5 A 78
e_pictorial(value, symbol) function is used for pictorial plots. The second parameter symbol refers to built-in symbols like circle, rect, roundRect, triangle, diamond, pin, arrow, icon, images and SVG Path. Built-in symbols can be used like symbol = "rect"

library(echarts4r)
library(echarts4r.assets)

df22 %>%
e_charts(x) %>%
e_pictorial(y, symbol = ea_icons("user"),
symbolRepeat = TRUE, z = -1,
symbolSize = c(20, 20)) %>%
e_theme("westeros") %>%
e_title("People Icons") %>%
e_flip_coords() %>%
# Hide Legend
e_legend(show = FALSE) %>%
# Remove Gridlines
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(splitLine=list(show = FALSE)) %>%
# Format Label
e_labels(fontSize = 16, fontWeight ='bold', position = "right", offset=c(10, 0))
Add Images in Chart
If you are using images, make sure to precede it with image:// before image address. In the code below, we have used paste0( ) function to concatenate it before image address.

Unity <- "https://im.rediff.com/news/2018/oct/29statue-of-unity.png"
Buddha <-"http://im.rediff.com/news/2018/oct/29spring-temple-buddha-china.png"

data <- data.frame(
x = c("Statue of Unity", "Spring Temple Buddha"),
value = c(182, 129),
symbol = c(paste0("image://", Unity),
paste0("image://", Buddha))
)

data %>%
e_charts(x) %>%
e_pictorial(value, symbol) %>%
e_theme("westeros") %>%
e_legend(FALSE) %>%
# Title Alignment
e_title("Statues Height", left='center', padding=10) %>%
e_labels(show=TRUE) %>%
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(show=FALSE, min=0,max=200, interval=20, splitLine=list(show = FALSE))
Pencil Chart in R
Instead of bars, we are using pencil to show comparison of values.

df02 <- data.frame(
x = LETTERS[1:10],
y = sort(sample(10:80,10), decreasing = TRUE)
)

df02 %>%
e_charts(x) %>%
e_pictorial(y, symbol = paste0("image://","https://1.bp.blogspot.com/-klwxpFekdEQ/XOubIhkalyI/AAAAAAAAHlE/25psl9x4oNkbJoLc2CKTXgV2pEj6tAvigCLcBGAs/s1600/pencil.png")) %>%
e_theme("westeros") %>%
e_title("Pencil Chart", padding=c(10,0,0,50))%>%
e_labels(show = TRUE)%>%
e_legend(show = FALSE) %>%
e_x_axis(splitLine=list(show = FALSE)) %>%
e_y_axis(show=FALSE, splitLine=list(show = FALSE))

Fill Male, Female Icons based on percentage

To find SVG Path, download desired SVG file from https://iconmonstr.com/ and open it in chrome and then find path in page source.

gender = data.frame(gender=c("Male", "Female"), value=c(65, 35),
path = c('path://M18.2629891,11.7131596 L6.8091608,11.7131596 C1.6685112,11.7131596 0,13.032145 0,18.6237673 L0,34.9928467 C0,38.1719847 4.28388932,38.1719847 4.28388932,34.9928467 L4.65591984,20.0216948 L5.74941883,20.0216948 L5.74941883,61.000787 C5.74941883,65.2508314 11.5891201,65.1268798 11.5891201,61.000787 L11.9611506,37.2137775 L13.1110872,37.2137775 L13.4831177,61.000787 C13.4831177,65.1268798 19.3114787,65.2508314 19.3114787,61.000787 L19.3114787,20.0216948 L20.4162301,20.0216948 L20.7882606,34.9928467 C20.7882606,38.1719847 25.0721499,38.1719847 25.0721499,34.9928467 L25.0721499,18.6237673 C25.0721499,13.032145 23.4038145,11.7131596 18.2629891,11.7131596 M12.5361629,1.11022302e-13 C15.4784742,1.11022302e-13 17.8684539,2.38997966 17.8684539,5.33237894 C17.8684539,8.27469031 15.4784742,10.66467 12.5361629,10.66467 C9.59376358,10.66467 7.20378392,8.27469031 7.20378392,5.33237894 C7.20378392,2.38997966 9.59376358,1.11022302e-13 12.5361629,1.11022302e-13',
'path://M28.9624207,31.5315864 L24.4142575,16.4793596 C23.5227152,13.8063773 20.8817445,11.7111088 17.0107398,11.7111088 L12.112691,11.7111088 C8.24168636,11.7111088 5.60080331,13.8064652 4.70917331,16.4793596 L0.149791395,31.5315864 C-0.786976655,34.7595013 2.9373074,35.9147532 3.9192135,32.890727 L8.72689855,19.1296485 L9.2799493,19.1296485 C9.2799493,19.1296485 2.95992025,43.7750224 2.70031069,44.6924335 C2.56498417,45.1567684 2.74553639,45.4852068 3.24205501,45.4852068 L8.704461,45.4852068 L8.704461,61.6700801 C8.704461,64.9659872 13.625035,64.9659872 13.625035,61.6700801 L13.625035,45.360657 L15.5097899,45.360657 L15.4984835,61.6700801 C15.4984835,64.9659872 20.4191451,64.9659872 20.4191451,61.6700801 L20.4191451,45.4852068 L25.8814635,45.4852068 C26.3667633,45.4852068 26.5586219,45.1567684 26.4345142,44.6924335 C26.1636859,43.7750224 19.8436568,19.1296485 19.8436568,19.1296485 L20.3966199,19.1296485 L25.2043926,32.890727 C26.1862111,35.9147532 29.9105828,34.7595013 28.9625083,31.5315864 L28.9624207,31.5315864 Z M14.5617154,0 C17.4960397,0 19.8773132,2.3898427 19.8773132,5.33453001 C19.8773132,8.27930527 17.4960397,10.66906 14.5617154,10.66906 C11.6274788,10.66906 9.24611767,8.27930527 9.24611767,5.33453001 C9.24611767,2.3898427 11.6274788,0 14.5617154,0 L14.5617154,0 Z'))

gender %>%
e_charts(gender) %>%
e_x_axis(splitLine=list(show = FALSE),
axisTick=list(show=FALSE),
axisLine=list(show=FALSE),
axisLabel= list(show=FALSE)) %>%
e_y_axis(max=100,
splitLine=list(show = FALSE),
axisTick=list(show=FALSE),
axisLine=list(show=FALSE),
axisLabel=list(show=FALSE)) %>%
e_color(color = c('#69cce6','#eee')) %>%
e_pictorial(value, symbol = path, z=10, name= 'realValue',
symbolBoundingData= 100, symbolClip= TRUE) %>%
e_pictorial(value, symbol = path, name= 'background',
symbolBoundingData= 100) %>%
e_labels(position = "bottom", offset= c(0, 10),
textStyle =list(fontSize= 20, fontFamily= 'Arial',
fontWeight ='bold',
color= '#69cce6'),
formatter="{@[1]}% {@[0]}") %>%
e_legend(show = FALSE) %>%
e_theme("westeros")

Show icon as label in plot

In label =, mention unicode of the fontawesome icon.

library(ggplot2)
ggplot (mtcars) +
geom_text( aes ( mpg , wt , colour = factor ( cyl )),
label = "uf1b9" ,
family = "FontAwesome" ,
size = 7)
16
Jun

How to build login page in R Shiny App

This tutorial covers how you can build login page where user needs to add username and password for authentication in shiny app. RStudio offers paid products like Shiny Server or RStudio Connect which has authentication feature to verify the identify of user. But if you want this feature for free, you can follow the steps mentioned below.
Features of R Program shown in the tutorial below
  1. Dashboard will be opened only when user enters correct username and password
  2. You can hide or show functionalities of dashboard (like tabs, widgets etc) based on type of permission
  3. Encrypt password with hashing algorithm which mitigates brute-force attacks
login form shiny

Steps to add login authentication feature in Shiny

Step 1 : Install the following packages by using the command install.packages(package-name)
  • shiny
  • shinydashboard
  • DT
  • shinyjs
  • sodium

Step 2 : Run the program below
library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)

# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br(),
br(),
tags$code("Username: myuser Password: mypass"),
br(),
tags$code("Username: myuser1 Password: mypass1")
))
)

credentials = data.frame(
username_id = c("myuser", "myuser1"),
passod = sapply(c("mypass", "mypass1"),password_store),
permission = c("basic", "advanced"),
stringsAsFactors = F
)

header <- dashboardHeader( title = "Simple Dashboard", uiOutput("logoutbtn"))

sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body"))
ui<-dashboardPage(header, sidebar, body, skin = "blue")

server <- function(input, output, session) {

login = FALSE
USER <- reactiveValues(login = login)

observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})

output$logoutbtn <- renderUI({
req(USER$login)
tags$li(a(icon("fa fa-sign-out"), "Logout",
href="javascript:window.location.reload(true)"),
class = "dropdown",
style = "background-color: #eee !important; border: 0;
font-weight: bold; margin:5px; padding: 10px;")
})

output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
sidebarMenu(
menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
)
}
})

output$body <- renderUI({
if (USER$login == TRUE ) {
tabItem(tabName ="dashboard", class = "active",
fluidRow(
box(width = 12, dataTableOutput('results'))
))
}
else {
loginpage
}
})

output$results <- DT::renderDataTable({
datatable(iris, options = list(autoWidth = TRUE,
searching = FALSE))
})

}

runApp(list(ui = ui, server = server), launch.browser = TRUE)
How to customize the program
  1. In the above program, two user names and passwords are defined
    Username : myuser Password : mypass Username : myuser1 Password : mypass1. To change them, you can edit the following code in R program.
     
    credentials = data.frame(
    username_id = c("myuser", "myuser1"),
    passod = sapply(c("mypass", "mypass1"),password_store),
    permission = c("basic", "advanced"),
    stringsAsFactors = F
    )
  2. In order to modify sidebar section, you can edit the following section of code.
        if (USER$login == TRUE ){ 
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
    )
    }
    In order to edit main body of the app, you can make modification in the following section of code.
      if (USER$login == TRUE ) {
    tabItem(tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))
    }
    else {
    loginpage
    }
  3. Suppose you want to show multiple tabs if permission level is set "advanced". Otherwise show a single tab. If you login with credentials Username : myuser1 Password : mypass1, you would find two tabs. Else it would show only one tab named "Main Page". Replace renderUI function of output$sidebarpanel and output$body with the following script.
      output$sidebarpanel <- renderUI({
    if (USER$login == TRUE ){
    if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("About Page", tabName = "About", icon = icon("th"))
    )
    }
    else{
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
    )

    }
    }
    })


    output$body <- renderUI({
    if (USER$login == TRUE ) {
    if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
    tabItems(
    tabItem(
    tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))
    ,
    tabItem(
    tabName ="About",
    h2("This is second tab")
    )
    )
    }
    else {
    tabItem(
    tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))

    }

    }
    else {
    loginpage
    }
    })
Note
Docker-based shinyproxy package is available for free which has an authentication feature along with some other great enterprise features. But you need to know docker to use this package and many users find it complicated.
16
Jun

How to build login page in R Shiny App

This tutorial covers how you can build login page where user needs to add username and password for authentication in shiny app. RStudio offers paid products like Shiny Server or RStudio Connect which has authentication feature to verify the identify of user. But if you want this feature for free, you can follow the steps mentioned below.
Features of R Program shown in the tutorial below
  1. Dashboard will be opened only when user enters correct username and password
  2. You can hide or show functionalities of dashboard (like tabs, widgets etc) based on type of permission
  3. Encrypt password with hashing algorithm which mitigates brute-force attacks
login form shiny

Steps to add login authentication feature in Shiny

Step 1 : Install the following packages by using the command install.packages(package-name)
  • shiny
  • shinydashboard
  • DT
  • shinyjs
  • sodium

Step 2 : Run the program below
library(shiny)
library(shinydashboard)
library(DT)
library(shinyjs)
library(sodium)

# Main login screen
loginpage <- div(id = "loginpage", style = "width: 500px; max-width: 100%; margin: 0 auto; padding: 20px;",
wellPanel(
tags$h2("LOG IN", class = "text-center", style = "padding-top: 0;color:#333; font-weight:600;"),
textInput("userName", placeholder="Username", label = tagList(icon("user"), "Username")),
passwordInput("passwd", placeholder="Password", label = tagList(icon("unlock-alt"), "Password")),
br(),
div(
style = "text-align: center;",
actionButton("login", "SIGN IN", style = "color: white; background-color:#3c8dbc;
padding: 10px 15px; width: 150px; cursor: pointer;
font-size: 18px; font-weight: 600;"),
shinyjs::hidden(
div(id = "nomatch",
tags$p("Oops! Incorrect username or password!",
style = "color: red; font-weight: 600;
padding-top: 5px;font-size:16px;",
class = "text-center"))),
br(),
br(),
tags$code("Username: myuser Password: mypass"),
br(),
tags$code("Username: myuser1 Password: mypass1")
))
)

credentials = data.frame(
username_id = c("myuser", "myuser1"),
passod = sapply(c("mypass", "mypass1"),password_store),
permission = c("basic", "advanced"),
stringsAsFactors = F
)

header <- dashboardHeader( title = "Simple Dashboard", uiOutput("logoutbtn"))

sidebar <- dashboardSidebar(uiOutput("sidebarpanel"))
body <- dashboardBody(shinyjs::useShinyjs(), uiOutput("body"))
ui<-dashboardPage(header, sidebar, body, skin = "blue")

server <- function(input, output, session) {

login = FALSE
USER <- reactiveValues(login = login)

observe({
if (USER$login == FALSE) {
if (!is.null(input$login)) {
if (input$login > 0) {
Username <- isolate(input$userName)
Password <- isolate(input$passwd)
if(length(which(credentials$username_id==Username))==1) {
pasmatch <- credentials["passod"][which(credentials$username_id==Username),]
pasverify <- password_verify(pasmatch, Password)
if(pasverify) {
USER$login <- TRUE
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
} else {
shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade")
shinyjs::delay(3000, shinyjs::toggle(id = "nomatch", anim = TRUE, time = 1, animType = "fade"))
}
}
}
}
})

output$logoutbtn <- renderUI({
req(USER$login)
tags$li(a(icon("fa fa-sign-out"), "Logout",
href="javascript:window.location.reload(true)"),
class = "dropdown",
style = "background-color: #eee !important; border: 0;
font-weight: bold; margin:5px; padding: 10px;")
})

output$sidebarpanel <- renderUI({
if (USER$login == TRUE ){
sidebarMenu(
menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
)
}
})

output$body <- renderUI({
if (USER$login == TRUE ) {
tabItem(tabName ="dashboard", class = "active",
fluidRow(
box(width = 12, dataTableOutput('results'))
))
}
else {
loginpage
}
})

output$results <- DT::renderDataTable({
datatable(iris, options = list(autoWidth = TRUE,
searching = FALSE))
})

}

runApp(list(ui = ui, server = server), launch.browser = TRUE)
How to customize the program
  1. In the above program, two user names and passwords are defined
    Username : myuser Password : mypass Username : myuser1 Password : mypass1. To change them, you can edit the following code in R program.
     
    credentials = data.frame(
    username_id = c("myuser", "myuser1"),
    passod = sapply(c("mypass", "mypass1"),password_store),
    permission = c("basic", "advanced"),
    stringsAsFactors = F
    )
  2. In order to modify sidebar section, you can edit the following section of code.
        if (USER$login == TRUE ){ 
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
    )
    }
    In order to edit main body of the app, you can make modification in the following section of code.
      if (USER$login == TRUE ) {
    tabItem(tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))
    }
    else {
    loginpage
    }
  3. Suppose you want to show multiple tabs if permission level is set "advanced". Otherwise show a single tab. If you login with credentials Username : myuser1 Password : mypass1, you would find two tabs. Else it would show only one tab named "Main Page". Replace renderUI function of output$sidebarpanel and output$body with the following script.
      output$sidebarpanel <- renderUI({
    if (USER$login == TRUE ){
    if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard")),
    menuItem("About Page", tabName = "About", icon = icon("th"))
    )
    }
    else{
    sidebarMenu(
    menuItem("Main Page", tabName = "dashboard", icon = icon("dashboard"))
    )

    }
    }
    })


    output$body <- renderUI({
    if (USER$login == TRUE ) {
    if (credentials[,"permission"][which(credentials$username_id==input$userName)]=="advanced") {
    tabItems(
    tabItem(
    tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))
    ,
    tabItem(
    tabName ="About",
    h2("This is second tab")
    )
    )
    }
    else {
    tabItem(
    tabName ="dashboard", class = "active",
    fluidRow(
    box(width = 12, dataTableOutput('results'))
    ))

    }

    }
    else {
    loginpage
    }
    })
Note
Docker-based shinyproxy package is available for free which has an authentication feature along with some other great enterprise features. But you need to know docker to use this package and many users find it complicated.
28
May

Data Science Jobs Report 2019: Python Way Up, Tensorflow Growing Rapidly, R Use Double SAS

In my ongoing quest to track The Popularity of Data Science Software, I’ve just updated my analysis of the job market. To save you from reading the entire tome, I’m reproducing that section here.

Job Advertisements

One of the best ways to measure the popularity or market share of software for data science is to count the number of job advertisements that highlight knowledge of each as a requirement. Job ads are rich in information and are backed by money, so they are perhaps the best measure of how popular each software is now. Plots of change in job demand give us a good idea of what is likely to become more popular in the future.

Indeed.com is the biggest job site in the U.S., making its collection of job ads the best around. As their  co-founder and former CEO Paul Forster stated, Indeed.com includes “all the jobs from over 1,000 unique sources, comprising the major job boards – Monster, CareerBuilder, HotJobs, Craigslist – as well as hundreds of newspapers, associations, and company websites.” Indeed.com also has superb search capabilities. It used to have a job trend plotter, but that tool has apparently been shut down.

Searching for jobs using Indeed.com is easy, but searching for software in a way that ensures fair comparisons across packages is challenging. Some software is used only for data science (e.g. SPSS, Apache Spark) while others are used in data science jobs and more broadly in report-writing jobs (e.g. SAS, Tableau). General-purpose languages (e.g. Python, C, Java) are heavily used in data science jobs, but the vast majority of jobs that use them have nothing to do with data science. To level the playing field, I developed a protocol to focus the search for each software within only jobs for data scientists. The details of this protocol are described in a separate article, How to Search for Data Science Jobs. All of the graphs in this section use those procedures to make the required queries.

I collected the job counts discussed in this section on May 27, 2019 and February 24, 2017. One might think that a sample of on a single day might not be very stable, but the large number of job sources makes the counts in Indeed.com’s collection of jobs quite consistent. Data collected in 2017 and 2014 using the same protocol correlated r=.94, p=.002.

Figure 1a shows that Python is in the lead with 27,374 jobs, followed by SQL with  25,877. Java and Amazon’s Machine Learning (ML) tools are roughly 25% further below, with jobs in the 17,000s. R and the C variants come next with around 13,000. People frequently compare R and Python, but when it comes to getting a data science job, there are only half as many for R as for Python. That doesn’t mean they’re the same sort of job, of course. I still see more statisticians using R and machine learning people preferring Python, but Python is definitely on a roll! From Hadoop on down, there is a slow decline in jobs. R is also frequently compared to SAS, which has only 8,123 compared to R’s 13,800.

The scale of Figure 1a is so wide that the bottom package, H20 appears to be zero, when in fact there are 257 jobs for it. 

Figure 1a. Number of data science jobs for the more popular software.

To let us compare the less popular software, I plotted them separately in Figure 1b. Mathematica and Julia are the leaders of this set, with around 219 jobs each. The ancient FORTRAN language is still hanging on to life with 195 jobs. The open source WEKA software and IBM’s Watson are next, with around 185 each. From XGBOOST on down, there is a fairly steady slow decline.

There are several tools that use a workflow interface: Enterprise Miner, KNIME, RapidMiner, and SPSS Modeler. They’re all around the same area between 50 and 100 jobs. In many of the other measures of popularity, RapidMiner beats the very similar KNIME tool, but here there are 50% more jobs for the latter. Alteryx is also a workflow-based tool, however, it has pulled away from the pack, appearing back on Figure 1a with 901 jobs.

Figure 1b. Number of jobs for less popular data science software tools, those with fewer than 250 advertisements.

When interpreting the scale on Figure 1b, what looks like zero is indeed zero. From Systat on down, none of the packages have more than 10 job listings.

It’s important to note that the values shown in Figures 1a and 1b are single points in time. The number of jobs for the more popular software do not change much from day to day. Therefore, the relative rankings of the software shown in Figure 1a is unlikely to change much over the coming year or two. The less popular packages shown in Figure 1b have such low job counts that their ranking is more likely to shift from month to month, though their position relative to the major packages should remain more stable.

Next, let’s look at the change in jobs from the 2017 data to now (2019). Figure 1c shows the percent change for those packages that had at least 100 job listings back in 2017. Without such a limitation, software that goes from 1 job in 2017 to 5 jobs in 2019 would have a 500% increase, but still would be of little interest. Software whose job market is heating up, or growing, is shown in red, while those that are cooling down are shown in blue.

Figure 1c. Percent change in job listings from 2017 to 2019. Only software that had at least 100 jobs in 2017 is shown.

Tensorflow, the deep learning software from Google, is the fastest growing at 523%. Next is Apache Flink, a tool that analyzes streaming data, at 289%. H2O is next, with 150% growth. Caffe is another deep learning framework and its 123% growth reflects the popularity of artificial intelligence algorithms.

Python shows “only” 97% growth, but its popularity was already so high that the 13,471 jobs that it added surpasses the total jobs of many of the other packages!

Tableau is showing a similar rate of growth, though it was a comparably small number of additional jobs, at 4,784.

From the Julia language on down, we see a slowing decrease in growth. I’m surprised to see that jobs for SAS and SPSS are still growing, though barely at 6% and 1%, respectively. 

If you enjoyed reading this article, you might be interested in my recent series of reviews on point-and-click front-ends for the R language. I invite you to subscribe to this blog, or follow me on Twitter.

24
May

Create Animation in R : Learn by Examples

This tutorial covers various ways you can create animated charts or plots using R. Animation is a very important element of data visualization. Animated charts are visually appealing and it fetches attention of audience. There are many online data visualization tools available in market which can generate animated charts but most of them are paid tools. Also problem with the online animation tools is that it asks you to upload data to their server, which is a data breach if you work on a real-world data of your client. Since R is open-source, you can download it for free and can create animated charts without moving data to server of any external server.

Simple Animation in R

Let's create dummy data for illustration. In the program below, we are generating 3 columns containing some random observations. First column named A contains 50 observations ranging from 1 to 75. Similarly second column contains similar number of observations but range interval is different.
df = data.frame(A=sample(1:75, 50, replace=TRUE),
B=sample(1:100, 50, replace=TRUE),
stringsAsFactors = FALSE)
gganimate package is used for animation in R. It is an extension of popular package for graphics - ggplot2 package.
library(ggplot2)
library(tidyverse)
library(gganimate)
library(directlabels)
library(png)
library(transformr)
library(grid)

ggplot(df, aes(A, B)) +
geom_line() +
transition_reveal(A) +
labs(title = 'A: {frame_along}')
Animation R
geom_line() is used for creating line chart. transition_reveal(A) allows you to let data gradually appear.frame_along gives the position that the current frame corresponds to.

What is frame and rendering in animation?

In animation, a frame is one of the many still images which compose the complete moving picture. Rendering is a kind of computing to output the final result. In gganimate package, it is by default 100 frames to render. You can change the number of frames under nframes= parameter in animatefunction.
p = ggplot(df, aes(A, B, group = C)) +
geom_line() +
transition_reveal(A) +
labs(title = 'A: {frame_along}')

animate(p, nframes=40)

How to save animated plot in GIF format file?

You can use anim_save(file_location,plot) function to export animated chart in GIF format.
anim_save("basic_animation.gif", p)

Frames per Second (fps)

It is the amount of time spend on each frame per second. You can use parameter fps in animate() function. By default, it is 10 frames per second.
animate(p, nframes=40, fps = 2)
Decreasing fps from 10 means slowing down speed of animation.

How to stop loop in animation?

Loop means continuously repeating animation over and over again. To end loop, you can use renderer = gifski_renderer(loop = FALSE) option in animate function.
animate(p, renderer = gifski_renderer(loop = FALSE))

How to change layout of plot?

You can change height and width of plot by mentioning the size in animate( ) function.
animate(p, fps = 10, duration = 14, width = 800, height = 400)

Advanced Animation in R : Examples

Prepare Data for Example
In this example, we will create bar chart showing change in monthly sales figure of different products.
set.seed(123)
dates = paste(rep(month.abb[1:10], each=10), 2018)
df = data.frame(Product=rep(sample(LETTERS[1:10],10), 10),
Period=factor(dates, levels=unique(dates)),
Sales=sample(1:100,100, replace = TRUE))
head(df)
Product Period Sales order
1 E Jan 2018 15 1
2 H Jan 2018 34 2
3 F Jan 2018 42 3
4 E Jan 2018 49 4
5 J Jan 2018 49 5
6 C Jan 2018 60 6
# Ranking by Period and Sales
df = df %>%
arrange(Period, Sales) %>%
mutate(order = 1:n())

# Animation
p = df %>%
ggplot(aes(order, Sales)) +
geom_bar(stat = "identity", fill = "#ff9933") +
labs(title='Total Sales in {closest_state}', x=NULL) +
theme(plot.title = element_text(hjust = 0.5, size = 18)) +
scale_x_continuous(breaks=df$order, labels=df$Product, position = "top") +
transition_states(Period, transition_length = 1, state_length = 2) +
view_follow(fixed_y=TRUE) +
ease_aes('cubic-in-out')

animate(p, nframes=50, fps=4)
anim_save("bar_animation.gif", p)
Detailed Explanation
  1. transition_states() animates plot by categorical or discrete variable. "States" are the animation sequences which plays. When a state transition is triggered, there will be a new state whose animation sequence will then run. In this case, state is Period column. state_length refers to relative length of the pause at the states. transition_length refers to relative length of the transition.
  2. view_follow(fixed_y=TRUE) means y-axis would be fixed when animation is running.
  3. ease_aes( ) refers to motion in animation that starts quickly and then decelerates. Or vice-versa.
  4. You can set theme using theme_set(theme_minimal())

Indian General Election (1984 to 2019) Study : Data Visualization

Recently BJP secured majority in Lok Sabha Election. In 1984, they contested first time in Lok Sabha Election. INC (Indian National Congress) used to be the biggest political party in India a decade ago. Here we will see the trend analysis on "% of seats won by these two parties) from 1984 to 2019. Source of Data : Election Commission of India
library(ggplot2)
library(tidyverse)
library(gganimate)
library(directlabels)
library(png)
library(transformr)
library(grid)

# Read Data
df = read.table(text =
" Year Perc_Seats Party
1984 0.79 INC
1989 0.38 INC
1991 0.45 INC
1996 0.27 INC
1998 0.27 INC
1999 0.22 INC
2004 0.28 INC
2009 0.4 INC
2014 0.09 INC
2019 0.1 INC
1984 0 BJP
1989 0.17 BJP
1991 0.23 BJP
1996 0.31 BJP
1998 0.35 BJP
1999 0.35 BJP
2004 0.27 BJP
2009 0.23 BJP
2014 0.52 BJP
2019 0.56 BJP
", header=TRUE)

# Set Theme
theme_set(theme_minimal())

# Plot and animate
p =
ggplot(data = df, aes(x= factor(Year), y=Perc_Seats, group=Party, colour=Party)) +
geom_line(size=2, show.legend = FALSE) +
scale_color_manual(values=c("#ff9933", "#006400")) +
scale_x_discrete(position = "top") +
scale_y_continuous(labels = scales::percent_format(accuracy = 1)) +
labs(title = 'Lok Sabha Election : % of seats won',
x = NULL, y = NULL) +
geom_text(aes(label=scales::percent(Perc_Seats, accuracy = 1),
vjust= -2), show.legend = FALSE) +
theme(plot.title = element_text(hjust = 0.5)) +
geom_dl(aes(label=Party), method="last.points") +
transition_reveal(Year) +
coord_cartesian(clip = 'off') +
ease_aes('cubic-in-out')

animate(p, fps = 10, width = 800, height = 400)
anim_save("election.gif", p)

How to save animated plot as video

Make sure ffmpeg is installed on your system before using the code below. It is available for download for all the operating systems.
animate(nations_plot, renderer = ffmpeg_renderer(), width = 800, height = 450)
anim_save("nations.mp4")

Compare Gross Domestic Product (GDP) by Countries

We used GDP PPP method for comparison. PPP stands for Purchasing Power Parity which is a method to compare GDP of different countries. It makes sure foreign exchange rate would not distort the comparison. Download Data File