Skip to content

Instantly share code, notes, and snippets.

@Chaitali20-gh
Created December 5, 2020 14:09
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Chaitali20-gh/6ad3875f661cf7b1b61d432158bb18e6 to your computer and use it in GitHub Desktop.
Save Chaitali20-gh/6ad3875f661cf7b1b61d432158bb18e6 to your computer and use it in GitHub Desktop.
Shiny_Automation
#global.R
library(shiny)
library(shinydashboard)
library(dplyr)
library(ggplot2)
library(googleVis)
library(DT)
library(tidyverse)
library(data.table)
library(ggthemes)
library(RColorBrewer)
library(stringr)
init_auto <- fread(file = "./automation_data_by_state.csv")
# Add Category
automation <- init_auto %>% mutate(.,category_m=ifelse(grepl("Education",Occupation),"Education",
ifelse(grepl("Engineer",Occupation),
"Engineering",
ifelse(grepl("Health",Occupation),
"Healthcare",
ifelse(grepl("Medical",Occupation),
"Healthcare",
ifelse(grepl("Software",Occupation),
"Technology",
ifelse(grepl("Teachers",Occupation),
"Education",
ifelse(grepl("Computer",Occupation),
"Technology",
ifelse(grepl("Therapists",Occupation),
"Healthcare",
ifelse(grepl("Technicians",Occupation),
"Machinery/Repairing Services",
ifelse(grepl("Repairers",Occupation),
"Machinery/Repairing Services",
ifelse(grepl("Equipment",Occupation),
"Machinery/Repairing Services",
ifelse(grepl("Machine",Occupation),
"Machinery/Repairing Services",
ifelse(grepl("Food",Occupation),
"Food Service",
ifelse(grepl("Cooks",Occupation),
"Food Service",
ifelse(grepl("Social",Occupation),
"Social Service",
ifelse(grepl("Sales",Occupation),
"Sales",
ifelse(grepl("Clerks",Occupation),
"Clerical Departments",
ifelse(grepl("Operators",Occupation),
"Clerical Departments",
ifelse(grepl("Workers",Occupation),
"Clerical Departments","Other"))))))))))))))))))))
#Job title list
choice <- select(automation,Occupation)
# Populate State Specific data
auto_map_new <-automation %>% select(-c(SOC)) %>% group_by(Occupation) %>%
gather(key = "State",value = "Count",Alabama:Wyoming, na.rm = TRUE) %>% mutate(State_prob = round(Count*Probability))
Overview_data <-auto_map_new %>% group_by(State) %>%
summarize(total = sum(State_prob))
# Top 10 high risk jobs
Risk_max <- automation %>% select(.,Probability,Occupation) %>% arrange(.,desc(Probability)) %>% head(10)
#ui.R
library(shinydashboard)
#automation<- read.csv(file = "automation_data_by_state.csv")
#Job tile filtering
shinyUI(dashboardPage(
dashboardHeader(title = "OCCUPATION VS. AUTOMATION",
titleWidth = 450),
dashboardSidebar(
sidebarUserPanel("USA JOBS", image = "http://www.mendaur.com/wp-content/uploads/2017/01/Tech-Jobs.jpg" ),
sidebarMenu(
menuItem("Overview", tabName = "view", icon = icon("exclamation-circle")),
menuItem("Summary", tabName = "title", icon = icon("clipboard-list")),
menuItem("Explore by Job title", tabName = "Occupation", icon = icon("user-friends")),
menuItem("Explore by State", tabName = "state", icon = icon("globe")),
#menuItem("Explore/Compare", tabName = "compare", icon = icon("globe")),
menuItem("Data", tabName = "data", icon = icon("database"))
)
),
dashboardBody(
tags$head(
tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
),
tabItems(
tabItem(tabName = "view",
# h1("US JOB RISK FOR AUTOMATION"),
fluidRow(infoBoxOutput("maxBox"),
infoBoxOutput("minBox"),
infoBoxOutput("avgBox")),
fluidRow(
box(img(src = "http://www.mendaur.com/wp-content/uploads/2017/01/Tech-Jobs.jpg",width="100%",height="40%"),
htmlOutput("hist",width="100%",height = 150)
),
box(htmlOutput("view"),
height = 570)
),
#fluidRow(box(htmlOutput("hist"),
#height = 150)),
),
tabItem(tabName = "title",
fluidRow( box(plotOutput("bar"),
height = 570),
box(plotOutput("category_b"),
height = 570))),
#box(htmlOutput("hist1"),
#height = 250),
#box(plotOutput("bar9"),
#height = 250))),
tabItem(tabName = "Occupation",
fluidRow(box(
background = "black",
selectInput(inputId = "job",
label = "Select Job Title",
choices = unique(automation$Occupation), selected = 'Chief Executives'),width = 4),
box(background = "black",
sliderInput("slider", "Select State Count Range:",1, 12, 8),
height = 90 ,width = 4),
infoBoxOutput("AutoProb")),
fluidRow(box(plotOutput("comp"),
height = 500),
box(plotOutput("comp_s"),
height = 500))),
tabItem(tabName = "state",
fluidRow(box(
background = "black",
selectInput(
inputId = "state",
label = "Select State",
choices = unique(auto_map_new$State), selected = 'Alaska'),width = 4),
box(background = "black",
textInput("text", "Search for similar job title:"),
height = 90 ,width = 4),
box(background = "black",
sliderInput("slider_st", "Select Job Title Range:",1, 10, 5),
height = 90 ,width = 4)
),
fluidRow(box(plotOutput("scatter_s"),
height = 500),
box(plotOutput("textplot"),
height = 500)),
),
tabItem(tabName = "data",
fluidRow(box(DT::dataTableOutput("table"), width = 12)))
)
)
))
#server.R
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
auto_title <- reactive({
auto_map_new %>%
filter(Occupation == input$job) %>% arrange(State_prob)
})
auto_state <- reactive({
auto_map_new %>%
filter(State == input$state)
})
auto_text <- reactive({
auto_map_new %>% filter(State == input$state) %>% filter(str_detect(str_to_lower(Occupation),tolower(input$text))) %>% summarise(Occupation,Probability,Count)
})
# show 10 most risky states for job title
output$comp <- renderPlot({
#auto_map_new %>% filter(Occupation == input$job) %>% arrange(desc(State_prob)) %>% head(5) %>%
auto_title() %>% arrange(desc(State_prob)) %>% head(10) %>%
ggplot(aes(x = State, y = Count, fill = State))+
geom_bar(stat="identity")+scale_fill_brewer( palette = "Blues")+xlab("")+ylab("")+
theme_bw() + ggtitle("Top 5 High Risk states")
})
# show 10 most risky states for job title - Slider
output$comp <- renderPlot({
#auto_map_new %>% filter(Occupation == input$job) %>% arrange(desc(State_prob)) %>% head(5) %>%
auto_title() %>% arrange(desc(State_prob)) %>% head(input$slider_st) %>%
ggplot(aes(x = State, y = Count, fill = State))+
geom_bar(stat="identity")+xlab("")+ylab("")+scale_fill_brewer( palette = "Blues")+
theme_bw() + ggtitle("Top 5 High Risk states")
})
# show 10 safe states for job title
output$comp_s <- renderPlot({
#auto_map_new %>% filter(Occupation == input$job) %>% arrange(desc(State_prob)) %>% head(5) %>%
auto_title() %>% arrange(State_prob) %>% head(input$slider) %>%
ggplot(aes(x = State, y = Count ,fill = State))+
geom_bar(stat="identity")+xlab("")+ylab("")+scale_fill_brewer( palette = "Blues")+
theme_bw() + ggtitle("Top 5 Safe states")
})
# show 10 safe states for job title - Slider
output$comp <- renderPlot({
#auto_map_new %>% filter(Occupation == input$job) %>% arrange(desc(State_prob)) %>% head(5) %>%
auto_title() %>% arrange(desc(State_prob)) %>% head(input$slider) %>%
ggplot(aes(x = State, y = Count, fill = State ))+
geom_bar(stat="identity")+xlab("")+ylab("")+scale_fill_brewer( palette = "Blues")+
theme_bw() + ggtitle("Top 5 High Risk states")
})
# Show Probability of Selected Title
output$AutoProb <- renderInfoBox({
#auto_text <- "Automation Probability"
value <-
automation$Probability[(automation$Occupation) == input$job]
infoBox("Automation Probability:", value, icon = icon("exclamation-circle"),width = 2, color = "red", fill = TRUE)
})
# show overview using googleVis
output$view <- renderGvis({
gvisGeoChart(Overview_data,"State","total",
options=list(region="US", displayMode="regions",
resolution="provinces",
width="100%", height="100%",
title = "US Job Automation Count",
(vAxes="[{title:'State based Job Automation Probability'}"),
colorAxis="{colors:['white', 'red']}",
backgroundColor="white"))
})
# Show Statistics of Overview data
output$maxBox <- renderInfoBox({
max_value <- max(Overview_data$total)
max_state <-
Overview_data$State[(Overview_data$total) == max_value]
infoBox(max_state, max_value, icon = icon("hand-o-up"),width = 2, color = "red", fill = TRUE)
})
output$minBox <- renderInfoBox({
min_value <- min(Overview_data$total)
min_state <-
Overview_data$State[(Overview_data$total) == min_value]
infoBox(min_state, min_value, icon = icon("hand-o-down"),width = 2, color = "navy", fill = TRUE)
})
output$avgBox <- renderInfoBox(
infoBox(paste("AVG.", "Automation Count"),
round(mean(Overview_data$total)),
icon = icon("calculator"), color = "aqua", fill = TRUE))
# search with text input
# show bar Chart of category
output$category <- renderPlot({
auto_map_new %>% filter(category_m != "Other") %>% count(category_m)%>%
ggplot(aes(y = category_m)) +
geom_density(aes(color = category_m))+theme(axis.text.x=element_blank()) +xlab("Job Category")+ylab("Job title Count") +theme_bw() +ggtitle("Job Category Density")
})
# Show boxlot of category
output$category_b <- renderPlot({
auto_map_new %>% filter(category_m != "Other") %>%
ggplot(aes(x = category_m, y = Count)) +geom_boxplot(aes(color = category_m))+
theme(axis.text.x=element_blank()) +xlab("Job Category")+ylab("Job title Count") +theme_bw() +ggtitle("Job Category Density")
})
# show bar Chart using ggplot - top 10 jobs impacting maximum number of people
output$bar <- renderPlot({
auto_map_new %>% group_by(Probability,Occupation) %>% summarize(Headcount = sum(Count)) %>%
arrange(desc(Headcount)) %>% head(10) %>% ggplot(aes(x = Headcount, y = Occupation, fill = "Headcount" ))+
geom_bar(stat="identity")+
scale_fill_brewer( palette = "Blues")+
theme_bw() +ggtitle("Top 10 Job Title impacting maximum people")+theme(plot.title = element_text(hjust = 0.5))
})
# show histogram using googleVis
output$hist <- renderGvis({
gvisHistogram(automation[,"Probability",drop=FALSE],options = list(width='100%', height='100%',color = 'red'))
})
# show scatter-plt for State provbaility vs Count using ggplot
output$scatter_s <- renderPlot({
auto_text() %>% ggplot(aes(x = Probability, y = Count )) +
geom_point(alpha=0.5, size=3, aes(color = Probability))+xlab("")+ylab("") +theme_bw() +ggtitle("Scatter plot for different job title")
})
# show state count map with title filter using googleVis
output$map <- renderGvis({
gvisGeoChart(auto_map_new,"State","State_prob",
options=list(region="US", displayMode="regions",
resolution="provinces",
width="auto", height="auto",
title = "State based Job Automation Probability",
(vAxes="[{title:'State based Job Automation Probability'}"),
colorAxis="{colors:['grey','navy']}",
backgroundColor="white"))
})
# Text seach info
output$textplot <- renderPlot({
#auto_map_new %>% filter(Occupation == input$job) %>% arrange(desc(State_prob)) %>% head(5) %>%
auto_text() %>% arrange(desc(Probability)) %>% arrange(desc(Count)) %>% head(input$slider_st) %>%
ggplot(aes(x = Occupation, y = Count, fill = Occupation ))+
geom_bar(stat="identity")+xlab("")+ylab("")+scale_fill_brewer( palette = "Blues")+
theme_bw() + ggtitle("Most Critical Jobs")
})
# show data using DataTable
output$table <- DT::renderDataTable({
datatable(automation, rownames=FALSE) %>%
formatStyle(input$Occupation, background="skyblue", fontWeight='bold')
})
})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment