C题 关于火车站股道和列检的问题

数据预处理

trainData <- read.csv("train.csv", header = T,
                      stringsAsFactors = F)[ ,-1] 
colnames(trainData) <- c("ID", "FromAndTo", "class", "arrive",
                         "go", "number", "delay", "other")
head(trainData)

##       ID       FromAndTo class   arrive       go number delay other
## 1 K596/3 乌鲁木齐-南京西  快速 08:53:00 09:01:00      5     8    　
## 2   8405       杨屯-徐州  通勤 09:15:00 09:25:00     10    NA    　
## 3   K101       北京-温州  快速 09:02:00 09:11:00      9     9    　
## 4   7062       沛屯-徐州  普客 09:06:00 09:16:00      2    NA    　
## 5    K55     哈尔滨-上海  快速 09:10:00 09:22:00      7    12    　
## 6   K515       长春-上海  快速 09:28:00 09:37:00      8     9    　

#train <- trainData
for(i in 1:nrow(trainData)) {
  #if(trainData[i, "go"] == "" )
 #   trainData[i, "go"] = trainData[i, "arrive"]
  if(is.na(trainData[i, "delay"]))
    trainData[i, "delay"] = 10
  #if(trainData[i, "arrive"] == "") 
   # trainData[i, "arrive"] = trainData[i, "go"]
   trainData[i, "arrive"] = paste("2014-09-12", trainData[i, "arrive"])
   trainData[i, "go"] = paste("2014-09-12", trainData[i, "go"])
    #trainData[i, "arrive"] = as.POSIXlt(paste("2014-09-12", 
     #                                         trainData[i, "arrive"]))
    #trainData[i, "go"] = as.POSIXlt(paste("2014-09-12", 
      #                                    trainData[i, "go"]))
}
trainData$go <- as.POSIXct(trainData$go)
trainData$arrive <- as.POSIXct(trainData$arrive)

toList <- function(trainData, q) {
  trainDataL <- list()
  for(i in unique(trainData[, q]))
    trainDataL[[i]] <- trainData[which(trainData[, q] == i),]
  return (trainDataL)
}
train2list <- toList(trainData, "number")
notbusy <- function(trainData) {
  time <- c(rep(0, nrow(trainData)))
  for(i in 1 : nrow(trainData))
    time[i] <- difftime(trainData[i, "go"], trainData[i, "arrive"],
                        units = "mins")
  #print(time)
  return(sum(time))
}
sumTime <- lapply(train2list, notbusy)
busy <- function(trainData){
 # trainDataframe <- trainData
  trainB <- trainData[order(trainData$arrive),]
#  trainB <- trainDataframe[order(trainDataframe$arrive), ]
  begin <- as.POSIXct("2014-09-12 08:00:00")
  end <- as.POSIXct("2014-09-12 19:00:00")
  inter <- c(rep(0, nrow(trainB) + 1))
  #print(inter)
  inter[1] <- as.numeric(difftime(trainB[1, "arrive"],
                                  begin, units = "mins" ))
  #print(inter)
  if(nrow(trainB) > 2)
    for(i in 2:(nrow(trainB)))
     inter[i] <- as.numeric(difftime(trainB[i, "arrive"], 
                                      trainB[i-1, "go"], 
                                       units = "mins"))
  inter[nrow(trainB)+1] <- as.numeric(difftime(end, 
                                               trainB[nrow(trainB), 
                                                      "go"],
                                    units = "mins"))
  return (sd(inter))
}
#trainDataframe <- train2list[[2]]
sdScores <- lapply(train2list, busy)
#get the var(inter)
busyScores <- as.numeric(sumTime)*as.numeric(sdScores)/(15*60)

问题一：描述股道的繁忙程度，并重新安排火车进站股道

\(n\)为每一个车道在早晨8点和晚7点之间通过的列车数量，\(t\)为每一辆列车在车站停留的时间。由此，我们定义在徐州站每一股道有火车在站的时间之和在早晨8点到晚上7点这段时间中占的比重（时间用分钟计算）， \[b = \frac{\sum_{i=1}^nt_i}{15\times 60}\] 但是这并没有考虑时间间隔对繁忙程度的影响，如果列车在站时间均匀的分布在早晨8点和晚上7点之前，那么该股道的繁忙程度无疑是最低的。分布越不均匀，繁忙成都越高。因此，定义\(inter\)为前一辆火车离站到下一辆火车到站之间的时间间隔。对于第一辆车的\(inter\)为早8点到第一辆扯进站的时间，最后一辆车的\(inter\)为最后一辆车离站到晚7点之间的时间，用每一个股道的方差来衡量分布的均匀程度，方差越小均匀程度越好，反之，则越差。因此，我们定义综合繁忙度为 \[busy_i = b_i\times var(inter_i) = \frac{\sum_{i=1}^nt_i}{15\times 60}\times var(inter_i) \quad i = 1,\dots,10, j=1,\dots,n_i\] 其中,\(busy_i\)是指第\(i\)股道的综合繁忙度，\(n_i\)是指在规定早晨8点到晚上7点之间第\(i\)股道上的靠站的火车数量。 由此，我们可以得到调整前的火车各个股道的繁忙程度。

首先我们获得每条股道上相应火车停靠时间分布

draw_h <- function(trainData, p) {
  plot(trainData[ ,p], trainData[ ,"arrive"],xaxp = c(0, 10, 10), 
       type = "n", xlab = "chedao", ylab = "time")
  for(i in 1:nrow(trainData))
    lines(c(trainData[i, p], trainData[i, p]), 
          c(trainData[i, "go"], trainData[i, "arrive"]), lwd = 5,
          col = "blue")
}
draw_h(trainData, "number")

图中横坐标为火车进站时间，纵坐标为火车出站时间，不同颜色代表不同股道上的火车，理想情况下，颜色应个分布均匀

library(RColorBrewer)
ncol <- brewer.pal(9, "Set1")
ncol[10] <- "#1B9E77"
library(ggplot2)
p <- ggplot(data = trainData, mapping = aes(x = trainData$go,
                                              y = trainData$arrive))
p + geom_point(aes(colour = factor(trainData[, "number"])), 
               size = I(5)) + 
  scale_color_manual(values = ncol)

重新排序后的到站火车时间分布

train <- trainData[which(trainData$number != 6),]
train <- train[order(train$arrive), ]

#train$rowNum <- c(1:nrow(train))
train$num2 <- c(rep(c(1,2,3,4,5,7,8,9,10), nrow(train)%/%9),
                c(1,2,3,4,5,7,8,9,10)[1:(nrow(train)%%9)])
draw_h(train, "num2")

  library(ggplot2)
  p <- ggplot(data = train, mapping = aes(x = train$go,
                                              y = train$arrive))
  p + geom_point(aes(colour = factor(train[, "num2"])), 
                 size = I(5)) +
  scale_color_manual(values = ncol)

重新调整算法 将到站时间从小到大依次排列，然后在1，2，3，4，5，7，9，10依次放置

调整前和调整后的繁忙度比较

afterTrain <- toList(train, "num2")
afterTrain[[6]] <- train2list[[6]]
afterTrain[[6]]$num2 <- 6
sdScores2 <- lapply(afterTrain, busy)
sumTime2 <- lapply(afterTrain, notbusy)
busyScores2 <- as.numeric(sumTime2)*as.numeric(sdScores2)/(15*60)

调整后繁忙度分布，明显降低

busyScore <- data.frame(busyScores, busyScores2)
rownames(busyScore) <- paste(1:10, "line", sep = " ")

draw_bar <- function(til, logic, ncol, yrange) {
par(mar = c(5,4,4,8), xpd = T)
  barplot(as.matrix(busyScore[,1:2]), beside = logic, col = ncol,
          border = "white", ylim = yrange, ylab = "BusyScores",
          main = til)
  legend("right", legend = rownames(busyScore), bty = "n", 
          fill = ncol, inset = c(-0.3, 0))
}
draw_bar("Compare the Extent of Busy for the Station in A Day", 
         F, ncol, c(0, 44))

draw_bar("Compare the Extent of Busy for Each Line in A Day", 
         T, ncol, c(0, 9))

barplot(t(as.matrix(busyScore[, 1:2])), beside = T,
        border = "white", col = c("red", "green4"), 
        ylim = c(0, 10), ylab = "BusyScores", 
        main = "Compare the Busy Score")
legend("top", horiz = T, legend = c("Privious", "Now"), 
        fill = c("red", "green4"), bty = "n")

问题二：如何达到跨越车倒数最小

算法

在时间T内没有工作，另T 初始化5支队伍， 当每一辆车进站时候，都检查每辆车相应的状态，选择出据状态为0的队伍， 从中选择出能够按时到达并且初跨越股倒数最少的车，如果跨越股道数相同，则选择之前完整任务时间靠前的队伍

diaodu <- read.csv("3.csv", stringsAsFactor = F)[ , -1]
colnames(diaodu) <- c("ID", "FromAndTo", "class", "arrive",
                         "go", "number", "delay", "other")
head(diaodu)

##       ID       FromAndTo class   arrive       go number delay other
## 1 K596/3 乌鲁木齐-南京西  快速 08:53:00 09:01:00      5     8    　
## 2   K101       北京-温州  快速 09:02:00 09:11:00      9     9    　
## 3    K55     哈尔滨-上海  快速 09:10:00 09:22:00      7    12    　
## 4   K515       长春-上海  快速 09:28:00 09:37:00      8     9    　
## 5   K174 西宁、兰州-四方  快速 09:52:00 10:25:00      3    33    　
## 6   K255       包头-宁波  快速 10:03:00 10:12:00      7     9    　

#train <- trainData
for(i in 1:nrow(diaodu)) {
  #if(trainData[i, "go"] == "" )
 #   trainData[i, "go"] = trainData[i, "arrive"]
  if(is.na(diaodu[i, "delay"]))
    diaodu[i, "delay"] = 15
  #if(trainData[i, "arrive"] == "") 
   # trainData[i, "arrive"] = trainData[i, "go"]
   diaodu[i, "arrive"] = paste("2014-09-12", diaodu[i, "arrive"])
   diaodu[i, "go"] = paste("2014-09-12", diaodu[i, "go"])
    #trainData[i, "arrive"] = as.POSIXlt(paste("2014-09-12", 
     #                                         trainData[i, "arrive"]))
    #trainData[i, "go"] = as.POSIXlt(paste("2014-09-12", 
      #                                    trainData[i, "go"]))
}
diaodu$go <- as.POSIXct(diaodu$go)
diaodu$arrive <- as.POSIXct(diaodu$arrive)
diaodu <- diaodu[which(diaodu$delay >=6), ]
diaodu$begintime <- diaodu$arrive - 180
diaodu <- diaodu[which(diaodu$other != "隔日"), ]
diaodu <- diaodu[order(diaodu$begintime), ]
row.names(diaodu) <- 1:nrow(diaodu)
team1 <- data.frame(overtime = 0, ID = 0, number = 0,
                   starttime = 0)
team2 <- team3 <- team4 <- team5 <- team1
line1 <- data.frame(endtime = 0, number = 0)
line10 <- line9 <- line8 <- line7 <- line6 <- line5 <- 
  line4 <- line3 <- line2 <- line1
team <- list(team1, team2, team3, team4, team5)
team_r <- team
line <- list(line1, line2, line3, line4, line5, line6,
             line7, line8, line9, line10)
line_r <- line




setLine <- function(begin_line, end_line) {
  set_line <- NULL
  set_line <- begin_line:end_line
  return (set_line)
}
#判断是否有火车停留在股道上
lineState <- function(line_number, arrive_time){
  if(line[[line_number]]$endtime == 0)
    return(0)
  if(arrive_time <= line[[line_number]]$endtime)
    return(1)
  else
    return(0)
  }
#判断队伍是否空闲
teamState <- function(team, new_train){
  if(team$overtime < new_train$begintime)
    return(TRUE)
  else
    return(FALSE)
}
#在某条股道上下一辆火车到来的时间
findNextLineTime <- function(rest_first, line_number, diaodu){
  return(diaodu[which(diaodu[rest_first:nrow(diaodu),]$number == line_number)+rest_first - 1,][1,]$begintime)
  }
#判断能否穿越股道
eitherCross <- function(new_train, team, set, rest_first, diaodu) {
  begintime <- new_train$begintime
  overtime <- team$overtime
  #temp_time <- 60
  #set <- setLine(team$number, new_train$number)
  #result_logic <- c(rep(0, length(set)-2))
  if(length(set) <= 2)
    return(TRUE)
  else
    for(line_number in set[2:(length(set)-1)]) {
      
      if(lineState(line_number, overtime + 60) == 1)
        return(FALSE)
      else {
        begin_time <- findNextLineTime(rest_first, line_number,
                                         diaodu)
        if(is.na(begin_time))
          overtime <- overtime + 120
        else{
          
          overtime <- overtime + 60
         # print(begin_time)
          #print(overtime)
            if(begin_time - 300 < overtime )
              return(FALSE)
          overtime <- overtime + 60
          }
        }
      
      }
    return(TRUE)
}
#能够到达指定股道
eitherArrive <- function(new_train, team, set, rest_first, diaodu){
  if(!teamState(team, new_train))
    return (FALSE)
  if(eitherCross(new_train, team, set, rest_first, diaodu))
    if(team$overtime + (length(set)-1)*60 < new_train$begintime)
      return(TRUE)
  else if(length(set) > 4)
    if(team$overtime + 480 < new_train$begintime)
      return(TRUE)
  else
    if(team$overtime + 360 < new_train$begintime)
      return(TRUE)
  
  return(FALSE)
}
diaodu1 <- diaodu
for(i in 1:5){
  team[[i]]$ID <- diaodu1[i, "ID"]
  team[[i]]$overtime <- diaodu1[i, "go"]
  team[[i]]$number <- diaodu1[i, "number"]
  team[[i]]$starttime <- diaodu1[i, "begintime"]
  line[[diaodu1[i, "number"]]]$endtime <- diaodu1[i, "go"]
  line[[diaodu1[i, "number"]]]$number <- diaodu1[i, "number"]
}
for(i in 1:5){
  team_r[[i]]$ID <- diaodu1[i, "ID"]
  team_r[[i]]$overtime <- diaodu1[i, "go"]
  team_r[[i]]$number <- diaodu1[i, "number"]
  team_r[[i]]$starttime <- diaodu1[i, "begintime"]
  line_r[[diaodu1[i, "number"]]]$endtime <- diaodu1[i, "go"]
  line_r[[diaodu1[i, "number"]]]$number <- diaodu1[i, "number"]
}

diaodu  <- diaodu1[6:nrow(diaodu1), ]
diaodu$team <- rep(0, nrow(diaodu))
rownames(diaodu) <- 1:nrow(diaodu)
set_team <- list()
for(i in 1:nrow(diaodu)) {
  new_train <- diaodu[i, ]
  temp <- 0
  for(j in 1:5) {
    
    temp_length <- 10
    set <- setLine(team[[j]]$number, new_train$number)
    if(eitherArrive(new_train, team[[j]], set, i+1, diaodu)){
     if(length(set) < temp_length ){
       
       temp_length <- length(set)
        temp <- j
       if(new_train$begintime - team[[j]]$overtime > 1800 )
         break
        
     }
      #else(i)
    }
  }
  #print(i)
  print(temp)
  diaodu[i, "team"] <- temp
  team[[temp]]$ID <- diaodu[i, "ID"]
team[[temp]]$overtime <- diaodu[i, "go"]
team[[temp]]$number <- diaodu[i, "number"]
team[[temp]]$starttime <- diaodu[i, "begintime"]
line[[diaodu[i, "number"]]]$endtime <- diaodu[i, "go"]
line[[diaodu[i, "number"]]]$number <- diaodu[i, "number"]

  team_r[[temp]][length(team[[temp]]$ID) + 1, "ID"] <- diaodu[i, "ID"]
team_r[[temp]][length(team[[temp]]$overtime) +1, "overtime"] <- diaodu[i, "go"]
team_r[[temp]][length(team[[temp]]$number)+1, "number"] <- diaodu[i, "number"]
team_r[[temp]][length(team[[temp]]$begintime) +1, "starttime"] <- diaodu[i, "begintime"]
#line_r[[diaodu1[i, "number"]]]$endtime <- diaodu1[i, "go"]
#line_r[[diaodu1[i, "number"]]]$number <- diaodu1[i, "number"]

}

## [1] 4
## [1] 3
## [1] 2
## [1] 3
## [1] 1
## [1] 5
## [1] 5
## [1] 5
## [1] 5
## [1] 4
## [1] 5
## [1] 5
## [1] 5
## [1] 3
## [1] 5
## [1] 2
## [1] 5
## [1] 5
## [1] 2
## [1] 2
## [1] 5
## [1] 4
## [1] 5
## [1] 2
## [1] 5
## [1] 4
## [1] 3
## [1] 5

diaodu1$team <- c(1:5,diaodu$team)
print(diaodu1)

##        ID       FromAndTo class              arrive                  go
## 1  K596/3 乌鲁木齐-南京西  快速 2014-09-12 08:53:00 2014-09-12 09:01:00
## 2    K101       北京-温州  快速 2014-09-12 09:02:00 2014-09-12 09:11:00
## 3     K55     哈尔滨-上海  快速 2014-09-12 09:10:00 2014-09-12 09:22:00
## 4    K515       长春-上海  快速 2014-09-12 09:28:00 2014-09-12 09:37:00
## 5    7061       徐州-沛屯  普客 2014-09-12 09:50:00 2014-09-12 10:05:00
## 6    K174 西宁、兰州-四方  快速 2014-09-12 09:52:00 2014-09-12 10:25:00
## 7    K255       包头-宁波  快速 2014-09-12 10:03:00 2014-09-12 10:12:00
## 8    1227       阜新-上海  普客 2014-09-12 10:09:00 2014-09-12 10:20:00
## 9  1554/1   太原-连云港东  普客 2014-09-12 10:21:00 2014-09-12 10:40:00
## 10   N392       徐州-沧口  快速 2014-09-12 10:30:00 2014-09-12 10:45:00
## 11   T160     广州东-四方  特快 2014-09-12 11:33:00 2014-09-12 11:54:00
## 12   1034   金华西-沈阳北  普客 2014-09-12 12:12:00 2014-09-12 12:25:00
## 13   5001   徐州-连云港东  普客 2014-09-12 12:45:00 2014-09-12 13:00:00
## 14   5005   徐州-连云港东  普客 2014-09-12 13:27:00 2014-09-12 13:42:00
## 15   1470     徐州-哈尔滨  普客 2014-09-12 13:29:00 2014-09-12 13:54:00
## 16   5008       徐州-济南  普客 2014-09-12 13:49:00 2014-09-12 14:04:00
## 17    K15     济南-重庆北  快速 2014-09-12 14:26:00 2014-09-12 14:34:00
## 18 K304/1   连云港东-广州  快速 2014-09-12 14:49:00 2014-09-12 14:57:00
## 19   K551     哈尔滨-温州  快速 2014-09-12 15:13:00 2014-09-12 15:21:00
## 20   7051   徐州-连云港东  普客 2014-09-12 15:15:00 2014-09-12 15:30:00
## 21   1033   沈阳北-金华西  普客 2014-09-12 15:22:00 2014-09-12 15:30:00
## 22 2526/7   上海-连云港东  普客 2014-09-12 15:56:00 2014-09-12 16:06:00
## 23   T159     四方-广州东  特快 2014-09-12 16:23:00 2014-09-12 16:53:00
## 24   7063       徐州-沛屯  普客 2014-09-12 16:27:00 2014-09-12 16:32:00
## 25 1066/3       汉口-威海  普客 2014-09-12 16:55:00 2014-09-12 17:06:00
## 26 K290/1       上海-成都  快速 2014-09-12 17:34:00 2014-09-12 17:40:00
## 27 K376/7       上海-西宁  快速 2014-09-12 17:41:00 2014-09-12 17:48:00
## 28    K16     重庆北-济南  快速 2014-09-12 18:11:00 2014-09-12 18:19:00
## 29   X238     杭州-哈尔滨  行包 2014-09-12 18:16:00 2014-09-12 18:31:00
## 30 K248/5       扬州-成都  快速 2014-09-12 18:31:00 2014-09-12 18:43:00
## 31   K108       徐州-北京  快速 2014-09-12 18:40:00 2014-09-12 18:55:00
## 32   8402       徐州-杨屯  通勤 2014-09-12 18:40:00 2014-09-12 18:55:00
## 33 1444/1   连云港东-汉口  普客 2014-09-12 19:00:00 2014-09-12 19:18:00
##    number delay other           begintime team
## 1       5     8    　 2014-09-12 08:50:00    1
## 2       9     9    　 2014-09-12 08:59:00    2
## 3       7    12    　 2014-09-12 09:07:00    3
## 4       8     9    　 2014-09-12 09:25:00    4
## 5       2    15    　 2014-09-12 09:47:00    5
## 6       3    33    　 2014-09-12 09:49:00    4
## 7       7     9    　 2014-09-12 10:00:00    3
## 8       9    11    　 2014-09-12 10:06:00    2
## 9       8    19    　 2014-09-12 10:18:00    3
## 10      5    15    　 2014-09-12 10:27:00    1
## 11      3    21    　 2014-09-12 11:30:00    5
## 12      5    13    　 2014-09-12 12:09:00    5
## 13     10    15    　 2014-09-12 12:42:00    5
## 14      8    15    　 2014-09-12 13:24:00    5
## 15      1    15    　 2014-09-12 13:26:00    4
## 16      7    15    　 2014-09-12 13:46:00    5
## 17      2     8    　 2014-09-12 14:23:00    5
## 18      1     8    　 2014-09-12 14:46:00    5
## 19     10     8    　 2014-09-12 15:10:00    3
## 20      9    15    　 2014-09-12 15:12:00    5
## 21      8     8    　 2014-09-12 15:19:00    2
## 22      3    10    　 2014-09-12 15:53:00    5
## 23      1    30    　 2014-09-12 16:20:00    5
## 24      4    15    　 2014-09-12 16:24:00    2
## 25      5    11    　 2014-09-12 16:52:00    2
## 26      2     6    　 2014-09-12 17:31:00    5
## 27      1     7    　 2014-09-12 17:38:00    4
## 28      2     8    　 2014-09-12 18:08:00    5
## 29      7    15    　 2014-09-12 18:13:00    2
## 30      4    12    　 2014-09-12 18:28:00    5
## 31      1    15    　 2014-09-12 18:37:00    4
## 32      9    15    　 2014-09-12 18:37:00    3
## 33      3    18    　 2014-09-12 18:57:00    5