749783406737663csgk_schedule.zip

##package load## library(tidyverse) library(RCurl) ##获取节假日信息 library(jsonlite) ##解析节假日API返回的Json数据 library(gramEvol) #遗传算法包 用于求解排班问题 ###name&requirement load## name_list <- read.csv("name_list.csv",encoding = "UTF-8",na.strings = "") ##calender_load## start = as.Date("2023/05/06") #指定起始日期 end = as.Date("2023/05/31") #指定结束日期 days <- seq.Date(start,end,by="day") month_info_orig <- getURI(paste0("http://timor.tech/api/holiday/batch?d=",paste0(as.character(days),collapse = ","),"&type=Y")) month_info <- parse_json(month_info_orig) sub_type <- function(x){ x$type } sub_week <- function(x){ x$week } month_info_type <- sapply(month_info$type,sub_type) month_info_week <- sapply(month_info$type,sub_week) ##获取到节假日信息：节假日类型0-3，分别表示 工作日、周末、节日、调休。 ##构建data.frame schedule <- matrix(data = NA,nrow = length(days),ncol = 4) %>% as.data.frame() colnames(schedule) <- c("Day","Week","week_num","Holidays") schedule$Day <- days schedule$Week <- weekdays(days) schedule$week_num <- month_info_week schedule$Holidays <- month_info_type schedule0 <- schedule #数据预处理 first_line_xianzhi <- name_list[,c(1,4,7,10)] second_line_xianzhi <- name_list[,c(3,6,9,12)] fuban_xianzhi <- name_list[,c(2,5,8,11)] #去除空行 first_line_xianzhi <- first_line_xianzhi[!is.na(first_line_xianzhi[,1]),] second_line_xianzhi <- second_line_xianzhi[!is.na(second_line_xianzhi[,1]),] fuban_xianzhi <- fuban_xianzhi[!is.na(fuban_xianzhi[,1]),] ###定义函数 f_paiban <- function(person_shche,doc=1){ paiban_celue <- c(1:(2^person_shche)) d <- c() for(n in 1:length(paiban_celue)){ b <- as.numeric(intToBits(paiban_celue[n]))[1:person_shche] %>% as.vector() d <- c(d,sum(b)==doc) ##如果是双人值班就改为2 } paiban_celue <- paiban_celue[d] return(paiban_celue) } f <- function(x){ for(m in 1:length(days)){ a <- as.numeric(intToBits(paiban_celue[x[m]]))[1:person_shche] %>% as.vector()#转转为2进制,0表示不值班，1表示值班 #扩展到shcedule上 schedule_dat[m,] <- a} #每个人硬性约束 #硬性1: 每周值班偏好 for(n in 1:nrow(yueshu)){ if(is.na(yueshu[n,3])){ week_select = 0 }else{ week_pre <- as.numeric(str_extract_all(yueshu[n,3],pattern = "[1-7]",simplify = T)) week_select<- ifelse(schedule_yueshu_week$week_num %in% week_pre,1,0) } schedule_yueshu_week <- cbind(schedule_yueshu_week,week_select) #硬性2：每周不能值班日期 if(is.na(yueshu[n,4])){ day_reject = 0 }else{ day_reject <- as.Date(str_extract_all(yueshu[n,4],pattern = "\\d+/\\d+/\\d+",simplify = T)) day_reject <- ifelse(schedule_yueshu_day$Day %in% day_reject,1,0) } schedule_yueshu_day <- cbind(schedule_yueshu_day,day_reject) } ##约束函数构建 xianzhi_dat0 <- schedule_dat #同一个人避免连续值班同一个人前后两天相乘尽量为0 #构建一个矩阵 第一行添加0，然后去掉最后一行 xianzhi_dat <- xianzhi_dat0 xianzhi_dat[nrow(xianzhi_dat),] <- 0 xianzhi_dat <- rbind(xianzhi_dat0,xianzhi_dat) xianzhi_dat <- xianzhi_dat[nrow(xianzhi_dat0):(nrow(xianzhi_dat)-1),] xianzhi_dat <- xianzhi_dat*xianzhi_dat0 #值班人的方差最小，周末以及日常班分开算，周末的权重高 total_zhiban <- colSums(xianzhi_dat0) gongzuo_zhiban <- colSums(xianzhi_dat0[which(schedule$Holidays %in% c("0","3")),]) jiejiari_zhiban <- colSums(xianzhi_dat0[which(schedule$Holidays %in% c("1","2")),]) #添加奖惩值班数目 xianzhi_opera <- as.numeric(yueshu[,2]) xianzhi_opera <- ifelse(is.na(xianzhi_opera),0,xianzhi_opera) gongzuo_zhiban <- gongzuo_zhiban + xianzhi_opera ##约束函数，硬性约束权重高，软约束权重低 fx <-sd(gongzuo_zhiban)*15 + sum(xianzhi_dat)*10+ sd(jiejiari_zhiban)*18 - sum(schedule_yueshu_week[,5:(4+person_shche)]*xianzhi_dat0)*5+ sum(schedule_yueshu_day[,5:(4+person_shche)]*xianzhi_dat0)*12 return(fx) } monitorFunc <- function(result){ cat("Best of gen: ", min(result$best$cost), "\n") } ##开始排班 ##排班—遗传算法(以一线为例) person_shche <- nrow(first_line_xianzhi) #即为变量总数 yueshu <- first_line_xianzhi schedule_dat <- matrix(data = NA,nrow = length(days),ncol = person_shche) colnames(schedule_dat) <- yueshu[,1] schedule_yueshu_week <- schedule schedule_yueshu_day <- schedule paiban_celue <- f_paiban(person_shche,doc=1) m <- GeneticAlg.int(genomeLen = as.numeric(length(days)), codonMin = 1, codonMax = length(paiban_celue), allowrepeat = T, terminationCost = -1000, monitorFunc = monitorFunc, evalFunc = f) print(m) best.result <- m$best$genome #数据解码 x <- paiban_celue[best.result] for(n in 1:length(days)){ a <- as.numeric(intToBits(x[n]))[1:person_shche] %>% as.vector()#转转为2进制,0表示不值班，1表示值班 #扩展到shcedule上 schedule_dat[n,] <- a} ##选取排班人员 doc_select <- function(x){ a <- c() for(n in 1:nrow(x)){ a <- c(a,(colnames(x)[which(x[n,] == 1)])) } return(a) } schedule0$first_line <- doc_select(schedule_dat) rm(person_shche,paiban_celue,yueshu) ####二线排班####################################################################### person_shche <- nrow(second_line_xianzhi) #即为变量总数 yueshu <- second_line_xianzhi schedule_dat <- matrix(data = NA,nrow = length(days),ncol = person_shche) colnames(schedule_dat) <- yueshu[,1] schedule_yueshu_week <- schedule schedule_yueshu_day <- schedule paiban_celue <- f_paiban(person_shche,doc=1) m <- GeneticAlg.int(genomeLen = as.numeric(length(days)), codonMin = 1, codonMax = length(paiban_celue), allowrepeat = T, terminationCost = -1000, monitorFunc = monitorFunc, evalFunc = f) print(m) best.result <- m$best$genome #数据解码 x <- paiban_celue[best.result] for(n in 1:length(days)){ a <- as.numeric(intToBits(x[n]))[1:person_shche] %>% as.vector()#转转为2进制,0表示不值班，1表示值班 #扩展到shcedule上 schedule_dat[n,] <- a} ##选取排班人员 doc_select <- function(x){ a <- c() for(n in 1:nrow(x)){ a <- c(a,(colnames(x)[which(x[n,] == 1)])) } return(a) } schedule0$second_line <- doc_select(schedule_dat) ####副班排班####################################################################### person_shche <- nrow(fuban_xianzhi) #即为变量总数 yueshu <- fuban_xianzhi schedule_dat <- matrix(data = NA,nrow = length(days),ncol = person_shche) colnames(schedule_dat) <- yueshu[,1] schedule_yueshu_week <- schedule schedule_yueshu_day <- schedule paiban_celue <- f_paiban(person_shche,doc=2) #双人值班 m <- GeneticAlg.int(genomeLen = as.numeric(length(days)), codonMin = 1, codonMax = length(paiban_celue), allowrepeat = T, terminationCost = -1000, monitorFunc = monitorFunc, evalFunc = f) print(m) best.result <- m$best$genome #数据解码 x <- paiban_celue[best.result] for(n in 1:length(days)){ a <- as.numeric(intToBits(x[n]))[1:person_shche] %>% as.vector()#转转为2进制,0表示不值班，1表示值班 #扩展到shcedule上 schedule_dat[n,] <- a} ##选取排班人员 doc_select <- function(x){ a <- c() for(n in 1:nrow(x)){ a <- c(a,paste0(colnames(x)[which(x[n,] == 1)],collapse = "/")) } return(a) } schedule0$fuban <- doc_select(schedule_dat) write.csv(schedule0,file = "auto_schedule.csv")