【R语言】期末大作业

头部:

---
title: "LZW HR_dashboard_report"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    source_code: embed
---
<style>                     
.navbar {
  background-color:maroon;
  border-color:white;
}
.navbar-brand {
color:white!important;
}
</style> 

 数据预处理1:

knitr::opts_chunk$set(echo = FALSE, warning = FALSE)
rm(list=ls())
options(warn=-1)
library(readxl)
library(ggplot2)
library(recharts)
library(shiny)
library(flexdashboard)
library(ggalt)
library(DT)
library(maps)
library(mapdata)
library(sp)
library(dplyr)
library(ggthemes)
library(lubridate)
library(sqldf)
library(xts)
library(forecast)
library(quantmod)
library(zoo)
library(tidyr)
library(grid)

 
orders1 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Americas.xlsx")
orders2 <- read_excel("G:/R default work directory/HR Dashboard_v1 - APAC.xlsx")
orders3 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Europe.xlsx")
entry <- read_excel("G:/R default work directory/entry.xlsx")
exit <- read_excel("G:/R default work directory/exit.xlsx")
gross <- read_excel("G:/R default work directory/gross.xlsx")

orders1$Continent <- rep('North America',times=40)

a<-rep('Asia',times=30)
b<-rep('Oceania',times=15)
c<-rep('Asia',times=5)

orders2$Continent <- c(a,b,c)

orders3$Continent <-rep('Europe',times=50)

orders1$Area <- rep('Americas',times=40)

orders2$Area <- rep('APAC',times=50)

orders3$Area <- rep('Europe',times=50)

orders4<-merge(orders1, orders2, all=TRUE)
orders0<-merge(orders3, orders4, all=TRUE)
orders<-orders0[,-c(1,2,3,4,5,6,14,15,22)]
orders$`Date of Exit`<- as.Date(as.numeric(orders$`Date of Exit`),origin="1899-12-30")
rm(orders4)
ordersx <- orders[!orders$`Type of movement` == 'Exit',]
ordersl <- orders[!orders$`Type of movement` == 'Entry',]

FlashBoard部分:

# Overview{data-icon="fa-globe"}
Column {data-width=600}{.tabset}
-------

数据预处理2:

names(exit)=c('country','counts','lat','long')
names(entry)=c('country','counts','lat','long')
names(gross)=c('country','counts','lat','long')

exit$long=as.numeric(as.character(exit$long))
exit$lat=as.numeric(as.character(exit$lat))
exit$counts=as.numeric(as.character(exit$counts))
entry$long=as.numeric(as.character(entry$long))
entry$lat=as.numeric(as.character(entry$lat))
entry$counts=as.numeric(as.character(entry$counts))
gross$long=as.numeric(as.character(gross$long))
gross$lat=as.numeric(as.character(gross$lat))
gross$counts=as.numeric(as.character(gross$counts))

exit$country[1]<-"United States of America"
entry$country[1]<-"United States of America"

FlashBoard部分:

### 入职员工分布

地图1:

worldcounts<-entry

b<-echartr(worldcounts, country, counts, type="map_world", subtype="move + scale") %>% setDataRange(splitNumber=0, color=getColFromPal('macarons')) %>% setTitle("入职员工分布")

b

FlashBoard部分:

### 离职员工分布

地图2:

worldcounts<-exit

a<-echartr(worldcounts, country, counts, type="map_world", subtype="move + scale")  %>%  setDataRange(splitNumber=0, color=getColFromPal('macarons')) %>% setTitle("离职员工分布")
a

FlashBoard部分:

### 员工变动分布图

员工变动分布图:

#员工变动分布图

mp<-NULL #定义一个空的地图 

mapworld<-borders("world",colour = "gray50",fill="white") #绘制基本地图 

mp<-ggplot()+mapworld+ylim(-90,90) + geom_point(aes(x=gross$long, y=gross$lat,size=gross$counts), color="red", alpha=0.5) + scale_size(range=c(2,9))+xlab("Longitude")+ylab("Latitude") + labs(size = "The Number of Movement") + theme (legend.position = "top",legend.text = element_text( face= "bold" ,size=10)) 

mp #将地图呈现出来

FlashBoard部分:

Column{data-width=85}
----
### 入职总人数

ValueBox1:

valueBox(93,icon = "fa-user-plus",color = "crimson")

FlashBoard部分:

### 离职总人数

ValueBox2:

valueBox(47,icon = "fa-user-minus",color = "coral")

FlashBoard部分:

### 入职流动比

仪表盘1:

gauge(round((93/140),2), min = 0, max = 1, 
gaugeSectors(success = c(0.6, 1), warning = c(0.2, 0.6), danger = c(0, 0.2)))

FlashBoard部分:

### 离职流动比

仪表盘2:

gauge(round((7/47),2), min = 0, max = 1, 
gaugeSectors(success = c(0.6, 1), warning = c(0.2, 0.6), danger = c(0, 0.2)))

FlashBoard部分:

### 非自愿离职

 仪表盘3:

gauge(round((47/140),2), min = 0, max = 1, 
gaugeSectors(success = c(0.6, 1), warning = c(0.2, 0.6), danger = c(0, 0.2)))

FlashBoard部分:

Column {data-width=315}
-----------
### 公司整体人员流动情况

图: 

echartr(mytable,Type.of.movement,Freq,type = 'pie')%>%
setTheme('macarons', calculable=TRUE)%>%
setSeries(radius = '65%')%>%
setTitle("Percentage of Entry and Exit")

FlashBoard部分:

### 公司整体人员流动情况

图: 

echartr(mytable,Type.of.movement,Freq,type = 'pie')%>%
setTheme('macarons', calculable=TRUE)%>%
setSeries(radius = '65%')%>%
setTitle("Percentage of Entry and Exit")

后续:

Studio {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同工作室人员流动数量
```{r}
mytable1<-xtabs(~Studio+`Type of movement`,data = orders)
mytable1 <- as.data.frame(mytable1)


echartr(mytable1, Studio, Freq, Type.of.movement, type='column', subtype='stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit across Studio")
```


Column{data-width = 500}
---
### 不同工作室人员流动比例
```{r}

echartr(mytable1, Studio, Freq,  facet=Type.of.movement, type='rose',subtype='radius')%>%
     setTheme('macarons', calculable=TRUE)%>%
     setSeries(radius = '40%')%>%
     setLegend(show = FALSE)%>%
     setTitle("Percentage of Entry and Exit across Studio")

```

Country {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同国家人员流动数量
```{r}
mytable2<-xtabs(~Country+`Type of movement`,data = orders)
mytable2 <- as.data.frame(mytable2)
echartr(mytable2, Country, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
     setTheme('macarons', calculable=TRUE)%>%
     setTitle("Frequency of Entry and Exit across Country",textStyle = list(fontSize = 15))%>%
     setXAxis(axisLabel = list(rotate = 45))
```


Column{data-width = 500}
---
### 不同国家人员流动比例
```{r}
echartr(mytable2, Country, Freq,  facet=Type.of.movement, type='rose',subtype='radius')%>%
setTheme('macarons', calculable=TRUE)%>%
setSeries(radius = '40%')%>%
setTitle("Percentage of Entry and Exit across Country",textStyle = list(fontSize = 20))
```

Manager {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同领导人名下人员流动数量
```{r}
mytable3<-xtabs(~`Manager Name`+`Type of movement`,data = orders)
mytable3 <- as.data.frame(mytable3)
echartr(mytable3, Manager.Name, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit Across Manager",textStyle = list(fontSize = 10))%>%
     setXAxis(axisLabel = list(rotate = 45))
```

Column{data-width = 500}
---
### 不同领导人名下人员流动比例
```{r}
echartr(mytable3, Manager.Name, Freq,facet= Type.of.movement, type='pie')%>%
setTheme('macarons', calculable=TRUE)%>%
  setSeries(radius = '40%')%>%
setTitle("Percentage of Entry and Exit across Manager")
```

Employment Type {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同岗位性质人员流动数量
```{r}
mytable4<-xtabs(~`Employment type`+`Type of movement`,data = orders)
mytable4 <- as.data.frame(mytable4)
echartr(mytable4, Employment.type, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit across Employment Type")
```

Column{data-width = 500}
---
### 不同岗位性质人员流动比例
```{r}
echartr(mytable4, Employment.type, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
    setTitle("Percentage of Entry and Exit across Employment Type")
```

Continent {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同大洲人员流动数量
```{r}
mytable7<-xtabs(~`Continent`+`Type of movement`,data = orders)
mytable7 <- as.data.frame(mytable7)
echartr(mytable7, Continent, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit across Continent")
```

Column{data-width = 500}
---
### 不同大洲人员流动比例
```{r}
echartr(mytable7, Continent, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
setTheme('macarons', calculable=TRUE)%>%
setSeries(radius = '40%')%>%
setTitle("Percentage of Entry and Exit across Continent")
```

Area {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同地区人员流动数量
```{r}
mytable8<-xtabs(~`Area`+`Type of movement`,data = orders)
mytable8 <- as.data.frame(mytable8)
echartr(mytable8, Area, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit across Area")
```

Column{data-width = 500}
---
### 不同地区人员流动比例
```{r}
echartr(mytable8, Area, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
setTheme('macarons', calculable=TRUE)%>%
setSeries(radius = '40%')%>%
setTitle("Percentage of Entry and Exit across Area")
```

Job Title {data-navmenu="Different Vision"}
=====================================

Column{data-width = 500}
---------
### 不同岗位名称人员流动数量
```{r}
mytable9<-xtabs(~`Job Title`+`Type of movement`,data = orders)
mytable9 <- as.data.frame(mytable9)
echartr(mytable9, Job.Title, Freq, Type.of.movement, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit across Job")
```

Column{data-width = 500}
---
### 不同岗位名称人员流动比例
```{r}
echartr(mytable9, Job.Title, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
setTheme('macarons', calculable=TRUE)%>%
setLegend(show = FALSE)%>%
setSeries(radius = '40%')%>%
setTitle("Percentage of Entry and Exit across Job")
```


Country {data-navmenu="Entry"}
=====================================

Column {data-width=500}
-------

### 不同国家入职人数
```{r warning=FALSE}
mytable10<-xtabs(~`Country`+`Type of movement`,data = ordersx)
mytable10 <- as.data.frame(mytable10)

echartr(mytable10, Country, Freq, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry across Country")
```

Column {data-width=500}
-------
### 不同国家入职比例
```{r}
echartr(mytable10, Country, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
         setSeries(radius = '60%')%>%
    setTitle("Percentage of Entry across Country ")
```

Continent {data-navmenu="Entry"}
=====================================

Column {data-width=500}
-------

### 不同大洲入职人数
```{r warning=FALSE}
mytable11<-xtabs(~`Continent`+`Type of movement`,data = ordersx)
mytable11 <- as.data.frame(mytable11)

echartr(mytable11, Continent, Freq, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry across Continent")
```

Column {data-width=500}
-------
### 不同大洲入职比例
```{r}
echartr(mytable11, Continent, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
         setSeries(radius = '60%')%>%
    setTitle("Percentage of Entry across Continent ")
```

Area {data-navmenu="Entry"}
=====================================

Column {data-width=500}
-------
### 不同地区入职人数
```{r warning=FALSE}
mytable12<-xtabs(~`Area`+`Type of movement`,data = ordersx)
mytable12 <- as.data.frame(mytable12)

echartr(mytable12, Area, Freq, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry across Area")
```

Column {data-width=500}
-------
### 不同地区入职比例
```{r}
echartr(mytable12, Area, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
         setSeries(radius = '60%')%>%
    setTitle("Percentage of Entry across Area ")
```



# Exit
Column {data-width=500}{.tabset}
-------
### 不同离职原因人数
```{r}
mytable5<-xtabs(~`Reason for Leaving`+`Type of movement`,data = ordersl)
mytable5 <- as.data.frame(mytable5)
echartr(mytable5, Reason.for.Leaving, Freq, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit Across Reason")

```

### 不同离职原因比例
```{r}
echartr(mytable5, Reason.for.Leaving, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
         setSeries(radius = '60%')%>%
    setTitle("Percentage of Entry and Exit across Reason for Leaving ")
```

Column {data-width=500}{.tabset}
-------
### 不同流失类型人数
```{r warning=FALSE}
mytable6<-xtabs(~`Attrition Type`+`Type of movement`,data = ordersl)
mytable6 <- as.data.frame(mytable6)

echartr(mytable6, Attrition.Type, Freq, type='column',subtype = 'stack')%>%
setTheme('macarons', calculable=TRUE)%>%
setTitle("Frequency of Entry and Exit Across Attrition Type")
```

### 不同流失类型比例
```{r}
echartr(mytable6, Attrition.Type, Freq, facet=Type.of.movement, type='rose',subtype='radius')%>%
    setTheme('macarons', calculable=TRUE)%>%
         setSeries(radius = '60%')%>%
    setTitle("Percentage of Entry and Exit across Attrition Type ")

```


Americas {data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 员工留存率:Americas
```{r}

file <- read_excel("G:/R default work directory/Americas-1.xlsx")
#file <- read_excel("G:/R default work directory/Americas-1.xlsx")
names(file)=c('Date1','type1','Date2','reason','type2','Work')
Dates.entry <- cut(file$Date1, breaks = "month") 
file <- data.frame(file, Dates.entry)
Dates.exit <- cut(file$Date2, breaks = "month") 
file <- data.frame(file, Dates.exit)
file <-file[-c(1,2,3,4,5,6)]


file.1<-table(file$Dates.entry)
file.2<-table(file$Dates.exit)
file.1<-data.frame(file.1)
file.2<-data.frame(file.2)
names(file.1)=c('time','counts')
names(file.2)=c('time','counts')

file.1<-file.1[,-c(1)]
file.2<-file.2[,-c(1)]

xts.1 <- xts(file.1,seq(as.POSIXct("2011-03-01"),len=103,by="month"))
chart_Series(xts.1) 

fit<-auto.arima(xts.1)
forecast <- forecast(fit,h=30,level=c(70))
plot(forecast)

xts.2 <- xts(file.2,seq(as.POSIXct("2019-01-01"),len=8,by="month"))
chart_Series(xts.2) 

fit<-auto.arima(xts.2)
forecast <- forecast(fit,h=10,level=c(30))
plot(forecast)
```

Column {data-width=400}
-------
### 分析

    图1、图3为采用“quantmod”包对美洲(Americas数据集)员工的入职和离职情况进行的时间序列相关分析结果,图为公司(美洲)该类员工入职/离职人数随时间变化的情况(2011年3月-2019年9月);图2、图4为依据截至目前的所有人员变动数据(美洲)、利用“forecast”包中的时间序列研究工具“差分整合移动平均自回归模型”(ARIMA模型),对入职/离职员工人数在未来一段时间内的变化进行估计,得到的结果。
    从图1、图3可见,公司(美洲)近两年(2018年-2019年第三季度)的新员工招募情况最为理想,相比前几年迎来爆发式增长,据此推测公司的福利待遇在提升、招募计划在扩大。同时,离职高潮在2019年初迎来峰值,公司(美洲)在一月份有4人离职,二月份有3人离职。离职员工主要分为工龄4-7年的老员工,以及工作不满一年的新进员工。新进员工离职可能原因为公司管理制度欠佳、薪酬待遇不理想、工作压力大、新员工对工作环境不适应等,需要管理层对此类问题提高重视;老员工近期出现同比较大幅度离职说明公司的改革制度可能触及老员工利益、或者大量招募员工对老员工的生存提出了挑战。一家公司的老员工是这家公司的中流砥柱,是公司众多资源培养下的、具有较高工作能力、熟悉公司具体业务的公司重要战略组成部分,近年老员工的流失警醒管理层应反思公司制度对老员工的实际影响,平衡上下级、新老员工的切身利益,助力公司更快、更好的成长。
    图2、图4则依据现有数据,对未来一段时间的员工入职/离职情况进行了预测。模型ARIMA对入职情况的预测精度为0.7,深度1/30,预测结果显示,在现有条件不变的情况下,未来一段时间入职员工数量会有振幅逐渐减小的可控震荡,最终趋于稳定。模型ARIMA对入职情况的预测精度为0.3,深度1/10,预测结果显示,短期内离职员工数量将维持稳定,不会呈明显下降趋势。因此,公司要在环境允许的前提下,适当改变公司制度,修正不当的安排和举措,降低近年暴增的离职率,同时在保证入职员工质量的前提下将员工入职率控制在合理和可接受的范围内。


Total Frequency{data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 全体员工入职/离职情况
```{r cars9}
file1 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Americas.xlsx")
file2 <- read_excel("G:/R default work directory/HR Dashboard_v1 - APAC.xlsx")
file3 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Europe.xlsx")

file1<-merge(file1,file2,all=TRUE)
file1<-merge(file1,file3,all=TRUE)

file1 <-file1[-c(1,2,3,4,5,6,7,8,9,11,12,13,14,15,16,20)]

#file1$'Date of Exit' <- as.Date(as.numeric(file1$'Date of Exit'))

names(file1)=c('Date1','type','Date2','reason','type2','Work')

Dates.entry <- cut(file1$Date1, breaks = "month") 
file1 <- data.frame(file1, Dates.entry)

Dates.exit <- cut(file1$Date2, breaks = "month") 
file1 <- data.frame(file1, Dates.exit)

file1 <-file1[-c(1,2,3,4,5,6)]


file.1<-table(file1$Dates.entry)
file.2<-table(file1$Dates.exit)
file.1<-data.frame(file.1)
file.2<-data.frame(file.2)
names(file.1)=c('time','counts')
names(file.2)=c('time','counts')



file.1<-file.1[,-c(1)]
file.2<-file.2[,-c(1)]

xts.1 <- xts(file.1,seq(as.POSIXct("2011-03-01"),len=103,by="month"))
chart_Series(xts.1) 

fit<-auto.arima(xts.1)
forecast <- forecast(fit,h=30,level=c(70))
plot(forecast)

xts.2 <- xts(file.2,seq(as.POSIXct("2019-01-01"),len=8,by="month"))
chart_Series(xts.2) 

fit<-auto.arima(xts.2)
forecast <- forecast(fit,h=10,level=c(30))
plot(forecast)

```

Column {data-width=400}
-------
### 分析
    
    该部分与对公司(美洲)的研究方法类似,研究对象扩大至公司在美洲、亚太、欧洲三地分公司全体员工的入职/离职情况。
    图1、图3为采用“quantmod”包对全体(Americas、APAC、Europe数据集)员工的入职和离职情况进行的时间序列相关分析结果;图2、图4为利用“forecast”包中的时间序列研究工具ARIMA模型,对入职/离职员工人数在未来一段时间内的变化进行估计,得出的结论。
    与美洲分公司的结果类似,公司整体情况显示,在过去8年中,前6年内,员工招募计划稳定,而在近2年,员工入职率暴增,一方面,原因可能来自公司自身的扩大和对人才需求的提升;另一方面,也与员工招募门槛的降低、公司治理结构的松散有一定关系。同时,预测结果显示,在现有条件既定的情况下,员工入职率和离职率会在短期震荡后趋于相对稳定的水平,但是不排除未来公司在制度和管理体系内的改革会对入职率和离职率产生新的影响。总体来讲,员工招募情况呈现亚健康状态。以下两点值得管理层思考:
    - 人才招募不是一朝一夕之事,结合许多大公司的发展历程,经验告诉我们,在创业过程中,公司各类人、财、物的积累方面,要遵循循序渐进的过程,保持稳定和健康的阶梯式发展,短期内的大量扩张必然反应公司某方面的不足和考虑欠佳。<br/>
    - 离职率的提升背后必然反映着某些制度、举措表现出的对新、老员工不同群体的恶意,公司管理层应当积极反思相关问题,对内协调各方利益、打造舒适健康的工作环境,对外营造良好口碑,成为一家制度更健全、招募更公开、管理更透明的优秀企业代表。


Total Ratio{data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 2011年3月-2019年9月全体员工留存率、流失率
```{r cars10}
sum1<-(sum(file.1)-sum(file.2))/sum(file.1) 
sum2<-sum(file.2)/sum(file.1)
sum3<-data.frame(Class=c('留存率','流失率'),Count=c(sum1,sum2))

options(warn=-1)
echartr(sum3, Class, Count, type='rose', subtype='radius') %>% setTitle('员工留存率&流失率分布图') %>% setSeries(radius = '50%') %>% setTheme('macarons', calculable=TRUE)

```

Column {data-width=400}
-------
### 分析

    结合数据图我们知道,公司全周期的员工流失量占公司总体员工数量的1/3,这个比例十分高,而且员工流失数量上的增长主要集中在2019年的8个月期间。一方面这是客观必然,结合同期招募量的上涨,有一定员工流失是可以接受的,但很难说这种“流水式”的在岗模式不会成为公司未来发展的一种新的、负面的趋势,因为能够看出公司自2018年中启动的大量招募措施是大量员工离职的直接推手,客观条件不变离职率将居高不下。员工是公司的命脉,人永远是第一位的,公司应当结合离职员工去向、离职原因、工作许可等情况对离职员工展开分析,从就此而映射公司制度设置和管理层面的不足,并予以修正。

Reason for Leaving{data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 时间轴上核心离职原因变更情况
```{r}

file1 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Americas.xlsx")
file2 <- read_excel("G:/R default work directory/HR Dashboard_v1 - APAC.xlsx")
file3 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Europe.xlsx")

file1<-merge(file1,file2,all=TRUE)
file1<-merge(file1,file3,all=TRUE)

file1 <-file1[-c(1,2,3,4,5,6,7,8,9,11,12,13,14,15,16,20)]
file1 <-file1[-c(1,2,5,6)]

names(file1)=c('Date','reason')

Dates.exit <- cut(file1$Date, breaks = "month") 
file1 <- data.frame(file1, Dates.exit)

file1 <-file1[-c(1,3)]


reason1<-length(which(file1$reason=='Better compensation'))
reason2<-length(which(file1$reason=='Better opportunity'))
reason3<-length(which(file1$reason=='Personal reasons'))
reason4<-length(which(file1$reason=='Project end'))
reason5<-length(which(file1$reason=='Disciplinary Action'))
reason6<-length(which(file1$reason=='Performance'))
total=reason1+reason2+reason3+reason4+reason5+reason6

reason1<-reason1/total
reason2<-reason2/total
reason3<-reason3/total
reason4<-reason4/total
reason5<-reason5/total
reason6<-reason6/total

Reason<-data.frame(reason=c('Better compensation','Better opportunity','Personal reasons','Project end','Disciplinary Action','Performance'),count=c(reason1,reason2,reason3,reason4,reason5,reason6))

#echartr(Reason, reason, count, type='rose', 
#        subtype='radius') %>%
#    setTitle('离职原因分布图') %>% setSeries(radius = '75%') %>% setTheme('helianthus', calculable=TRUE)

g <- echartr(Reason, reason, count,facet=reason,type='ring',subtype = 'info') %>% 
    setTheme('macarons') %>%
    setTitle('离职原因分布', pos=c('center','center', 'horizontal')) 

width = 800
height = 600
g %>% setLegend(pos=c('center','top','vertical'), itemGap=height/25) %>%
    relocLegend(x=width/1.7, y=height/8)
```

Column {data-width=400}
-------
### 分析
    
    此图为公司(Americas、APAC、Europe数据集)员工离职原因分布。总体来看,员工离职原因相对客观、比例十分合理。员工主要的离职原因为去待遇更好的公司就职,约占六成;部分员工因自身家庭、身体等特殊原因离职,约占两成;另有少部分员工因纪律、表现等问题离职,约占两成。
    该离职原因分布逻辑合理,但体现如下问题:
    - 公司在体制、待遇等方面尚存较大提升空间,有机会留住更加优秀的员工。
    - 因纪律、表现等问题离职的员工存在,但占比合理,体现了公司管理体制的筛选效率,该部分优秀制度应合理保留,并结合公司自身发展情况进行调整。
    - “Project end”部分离职占比约为6%,此部分员工应为公司招募的临时员工,或外包项目成员,是健康合理的员工流失类型,公司在合理考察的基础上可以一定比例吸收该类员工,作为公司的永久员工。


Work Authorisation{data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 入职/离职工作许可类型判定
```{r cars77}
file1 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Americas.xlsx")
file2 <- read_excel("G:/R default work directory/HR Dashboard_v1 - APAC.xlsx")
file3 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Europe.xlsx")

file1<-merge(file1,file2,all=TRUE)
file1<-merge(file1,file3,all=TRUE)

file1 <-file1[-c(1,2,3,4,5,6,7,8,9,11,12,13,14,15,16,20)]
file1 <-file1[-c(1,3,4,5)]
names(file1)=c('type','work')

shai <- file1[file1$type == 'Exit',]

A<-length(which(shai$work=='Citizen'))
B<-length(which(shai$work=='Permanent Resident'))
total=A+B
A<-A/total
B<-B/total

shai<-data.frame(type=c('Citizen','Permanent Resident'),count=c(A,B))

g <- echartr(shai, type, count,facet=type,type='ring',subtype = 'info') %>% 
    setTheme('macarons') %>%
    setTitle('工作许可情况', pos=c('center','center', 'horizontal')) 

width = 800
height = 600
g %>% setLegend(pos=c('center','top','vertical'), itemGap=height/25) %>%
    relocLegend(x=width/1.45, y=height/8)

```

Column {data-width=400}
-------
### 分析


    此图为离职员工工作许可情况分布。如图所示,公司离职员工主要为当地居民,其次是拥有当地永久签证的外国居民,没有领工作签证的外国籍员工离职。该统计结果反映出,主要的离职员工均为在本地有找工作能力和永久居住能力的员工,这也反映出居民类和永签类职工具有更大的不确定性,以及更加明显的离职倾向。公司应当善于把握此类动向,给予重要的居民类和永签类职工以待遇提升、并加以挽留,防止重要员工流向竞争对手,并对未来五年内可能发生的此类员工的离职做好准备。此外,公司应加大对领工作签证的外籍员工的培养和资源投入,把握这一员工群体的相对稳固性,并发挥他们的潜在价值。

工作时限{data-navmenu="Forecast"}
=====================================

Column {data-width=600}
-------
### 离岗员工在岗时间分布

```{r}
file1 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Americas.xlsx")
file2 <- read_excel("G:/R default work directory/HR Dashboard_v1 - APAC.xlsx")
file3 <- read_excel("G:/R default work directory/HR Dashboard_v1 - Europe.xlsx")

file1<-merge(file1,file2,all=TRUE)
file1<-merge(file1,file3,all=TRUE)

file1 <-file1[-c(1,2,3,4,5,6,7,8,9,11,12,13,14,15,16,20)]

#file1$'Date of Exit' <- as.Date(as.numeric(file1$'Date of Exit'))

names(file1)=c('Date1','type','Date2','reason','type2','Work')

Dates.entry <- cut(file1$Date1, breaks = "month") 
file1 <- data.frame(file1, Dates.entry)

Dates.exit <- cut(file1$Date2, breaks = "month") 
file1 <- data.frame(file1, Dates.exit)

file1 <-file1[-c(1,2,3,4,5,6)]


exit<-file1 %>% drop_na(Dates.exit)
exit<-data.frame(exit)

time<-c(as.Date(exit$Dates.exit)-as.Date(exit$Dates.entry))
time<-data.frame(time)
time<-data.frame(c(1:47),time)
names(time)=c('Class','Count')

time$Count=as.numeric(time$Count)
time$Class=as.character(time$Class)

#echartr(time, point ,long, type='auto')
#echartr(time,point,width=600) %>%
 #  setTitle('Iris: Histogram of Sepal.Width') %>%
  # setTooltip(formatter='none') %>% setSeries(1, barWidth=100/13)
echartr(time, Class, Count, type='column') %>%
    setTitle('离岗员工在岗时间分布')

```

Column{data-width=400}
-----
### 分析

    此图为截至2019年9月,公司(Americas、APAC、Europe数据集)总计47名离职员工的在岗期间工龄分布图。如图所示,离职员工在岗最长期限为3075天,逾7年,最短为90天,约三个月。绝大部分员工离职时累计在岗时间超过两年,约七成员工员工离职时在岗时间超过1000天,为老员工。
    结合公司总体入职/离职情况,不应将员工于2019年开始出现的密集离职潮仅仅归咎于2018年开始的大量招募所引起的“新人试错成本”,而应该着眼于数据,明确当下公司呈现的老员工离职新趋势,将着眼点聚焦于新老员工利益均衡,以及对骨干员工的挽留等补救措施上。
    此外,员工的双向流动率(入职率、离职率)出现较大幅度波动也说明公司进入快速发展阶段,公司更应在此阶段良好把握发展机遇,快速代谢,替换工作能力欠缺者、招募工作水平优良者,对公司人力资源进行全面换血,从而推动自身制度水平和业务能力不断发展。



# Data{data-icon="fa-list"}

```{r}
datatable(orders, extensions = 'Buttons', options = list(dom = 'Bfrtip',buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),pageLength = 25))

```

# About Us{data-icon="fa-users"}
Column {data-width=333}
-----------
### 冷忞杰

<center><img src="冷忞杰.jpeg" width="300" height="400"/></center><br/><br/>
<center>姓名:冷忞杰</center>
<center>学号:2017212158</center>
<center>分工:数据预处理/地图绘制/新问题、新趋势预测分析<br/></center>

Column {data-width=334}
-----------
### 赵晓杰
<center><img src="赵晓杰.jpeg" width="300" height="400"/></center><br/><br/>
<center>姓名:赵晓杰</center>
<center>学号:2017212043</center>
<center>分工:数据预处理/公司入职、离职员工分析/Flexdashboard整合<br/></center>


Column {data-width=333}
-----------
### 王云舒
<center><img src="王云舒.jpeg" width="300" height="500"/></center><br/><br/>
<center>姓名:王云舒</center>
<center>学号:2017212022</center>
<center>分工:数据预处理/公司入职、离职员工分析/Flexdashboard整合<br/></center>

猜你喜欢

转载自blog.csdn.net/weixin_42067401/article/details/106791104