API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Sep 18th, 2018
74
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 14.13 KB | None | 0 0
raw download clone embed print report
  1. #' dumbDM
  2. #'
  3. #' This control function just moves randomly, until all packages are picked up and delivered by accident!
  4. #' @param roads See help documentation for the runDeliveryMan function
  5. #' @param cars See help documentation for the runDeliveryMan function
  6. #' @param packages See help documentation for the runDeliveryMan function
  7. #' @return See help documentation for the runDeliveryMan function
  8. #' @export
  9. dumbDM=function(roads,car,packages){
  10.   car$nextMove=sample(c(2,4,6,8),1)
  11.   return (car)
  12. }
  13. #' basicDM
  14. #'
  15. #' This control function will pick up the closest package (using distance and ignoring traffic).
  16. #' As a first step, you should make sure you do better than this.
  17. #' @param roads See help documentation for the runDeliveryMan function
  18. #' @param cars See help documentation for the runDeliveryMan function
  19. #' @param packages See help documentation for the runDeliveryMan function
  20. #' @return See help documentation for the runDeliveryMan function
  21. #' @export
  22. basicDM=function(roads,car,packages) {
  23.   nextMove=0
  24.   toGo=0
  25.   offset=0
  26.   if (car$load==0) {
  27.     toGo=which(packages[,5]==0)[1]
  28.   } else {
  29.     toGo=car$load
  30.     offset=2
  31.   }
  32.   if (car$x<packages[toGo,1+offset]) {nextMove=6}
  33.   else if (car$x>packages[toGo,1+offset]) {nextMove=4}
  34.   else if (car$y<packages[toGo,2+offset]) {nextMove=8}
  35.   else if (car$y>packages[toGo,2+offset]) {nextMove=2}
  36.   else {nextMove=5}
  37.   car$nextMove=nextMove
  38.   car$mem=list()
  39.   return (car)
  40. }
  41. #' manualDM
  42. #'
  43. #' If you have the urge to play the game manually (giving moves 2, 4, 5, 6, or 8 using the keyboard) you
  44. #' can pass this control function to runDeliveryMan
  45. #' @param roads See help documentation for the runDeliveryMan function
  46. #' @param cars See help documentation for the runDeliveryMan function
  47. #' @param packages See help documentation for the runDeliveryMan function
  48. #' @return See help documentation for the runDeliveryMan function
  49. #' @export
  50. manualDM=function(roads,car,packages) {
  51.   if (car$load>0) {
  52.     print(paste("Current load:",car$load))
  53.     print(paste("Destination: X",packages[car$load,3],"Y",packages[car$load,4]))
  54.   }
  55.   car$nextMove=readline("Enter next move. Valid moves are 2,4,6,8,0 (directions as on keypad) or q for quit.")
  56.   if (car$nextMove=="q") {stop("Game terminated on user request.")}
  57.   return (car)
  58. }
  59.  
  60. #' testDM
  61. #'
  62. #' Use this to debug under multiple circumstances and to see how your function compares with the par function
  63. #' The mean for the par function (with n=500) on this is 172.734, and the sd is approximately 39.065.
  64. #'
  65. #' Your final result will be based on how your function performs on a similar run of 500 games, though with
  66. #' a different seed used to select them.
  67. #'
  68. #' This set of seeds is chosen so as to include a tricky game that has pick ups and deliveries on the same
  69. #' spot. This will occur in the actual games you are evaluated on too.
  70. #'
  71. #' While this is dependent on the machine used, we expect your function to be able to run the 500 evaluation games on
  72. #' the evaluation machine in under 4 minutes (250 seconds). If the evaluation machine is slower than expected,
  73. #' this will be altered so that the required time is 25% slower than the par function.
  74. #'
  75. #' The par function takes approximately 96 seconds on my laptop (with n=500 and verbose=0).
  76. #'
  77. #' @param myFunction The function you have created to control the Delivery Man game.
  78. #' @param verbose Set to 0 for no output, 1 for a summary of the results of the games played (mean,
  79. #' standard deviation and time taken), and 2 for the above plus written output detailing seeds used and the
  80. #' runDeliveryMan output of the result of each game.
  81. #' @param returnVec Set to TRUE if you want the results of the games played returned as a vector.
  82. #' @param n The number of games played. You will be evaluated on a set of 500 games, which is also the default here.
  83. #' @param timeLimit The time limit. If this is breached, a NA is returned.
  84. #' @return If returnVec is false, a scalar giving the mean of the results of the games played. If returnVec is TRUE
  85. #' a vector giving the result of each game played. If the time limit is breached, a NA is returned.
  86. #' @export
  87. testDM=function(myFunction,verbose=0,returnVec=FALSE,n=500,seed=21,timeLimit=250){
  88.   if (!is.na(seed))
  89.     set.seed(seed)
  90.   seeds=sample(1:25000,n)
  91.   startTime=Sys.time()
  92.   aStar=sapply(seeds,function(s){
  93.     midTime=Sys.time()
  94.     if (as.numeric(midTime)-as.numeric(startTime)>timeLimit) {
  95.       cat("\nRun terminated due to slowness.")
  96.       return (NA)
  97.     }
  98.     set.seed(s)
  99.     if (verbose==2)
  100.       cat("\nNew game, seed",s)
  101.     runDeliveryMan(myFunction,doPlot=F,pause=0,verbose=verbose==2)
  102.   })
  103.   endTime=Sys.time()
  104.   if (verbose>=1){
  105.     cat("\nMean:",mean(aStar))
  106.     cat("\nStd Dev:",sd(aStar))
  107.     cat("\nTime taken:",as.numeric(endTime)-as.numeric(startTime),"seconds.")
  108.   }
  109.   if (returnVec)
  110.     return(aStar)
  111.   else
  112.     return (mean(aStar))
  113. }
  114.  
  115. #' Run Delivery Man
  116. #'
  117. #' Runs the delivery man game. In this game, deliveries are randomly placed on a city grid. You
  118. #' must pick up and deliver the deliveries as fast as possible under changing traffic conditions.
  119. #' Your score is the time it takes for you to complete this task. To play manually pass manualDM
  120. #' as the carReady function and enter the number pad direction numbers to make moves.
  121. #' @param carReady Your function that takes three arguments: (1) a list of two matrices giving the
  122. #' traffice conditions. The first matrix is named 'hroads' and gives a matrix of traffice conditions
  123. #' on the horizontal roads. The second matrix is named 'vroads' and gives a matrix of traffic
  124. #' conditional on the vertical roads. <1,1> is the bottom left, and <dim,dim> is the top right.
  125. #'(2) a list providing information about your car. This
  126. #' list includes the x and y coordinates of the car with names 'x' and 'y', the package the car
  127. #' is carrying, with name 'load' (this is 0 if no package is being carried), a list called
  128. #' 'mem' that you can use to store information you want to remember from turn to turn, and
  129. #' a field called nextMove where you will write what you want the car to do. Moves are
  130. #' specified as on the number-pad (2 down, 4 left, 6 right, 8 up, 5 stay still). (3) A
  131. #' matrix containing information about the packages. This contains five columns and a row for each
  132. #' package. The first two columns give x and y coordinates about where the package should be picked
  133. #' up from. The next two columns give x and y coordinates about where the package should be
  134. #' delivered to. The final column specifies the package status (0 is not picked up, 1 is picked up but not
  135. #' delivered, 2 is delivered).
  136. #' Your function should return the car object with the nextMove specified.
  137. #' @param dim The dimension of the board. You will be scored on a board of dimension 10. Note that
  138. #' this means you will have to remove duplicated nodes from your frontier to keep your AStar
  139. #' computationally reasonable! There is a time limit for how long an average game can be run in, and
  140. #' if your program takes too long, you will penalized or even fail.
  141. #' @param turns The number of turns the game should go for if deliveries are not made. Ignore this
  142. #' except for noting that the default is 2000 so if you have not made deliveries after 2000 turns
  143. #' you fail.
  144. #' @param doPlot Specifies if you want the game state to be plotted each turn.
  145. #' @param pause The pause period between moves. Ignore this.
  146. #' @param del The number of deliveries. You will be scored on a board with 5 deliveries.
  147. #' @return A string describing the outcome of the game.
  148. #' @export
  149. runDeliveryMan <- function (carReady=manualDM,dim=10,turns=2000,
  150.                             doPlot=T,pause=0.1,del=5,verbose=T) {
  151.   roads=makeRoadMatrices(dim)
  152.   car=list(x=1,y=1,wait=0,load=0,nextMove=NA,mem=list())
  153.   packages=matrix(sample(1:dim,replace=T,5*del),ncol=5)
  154.   packages[,5]=rep(0,del)
  155.   for (i in 1:turns) {
  156.     roads=updateRoads(roads$hroads,roads$vroads)
  157.     if (doPlot) {
  158.       makeDotGrid(dim,i)
  159.       plotRoads(roads$hroads,roads$vroads)
  160.       points(car$x,car$y,pch=16,col="blue",cex=3)
  161.       plotPackages(packages)
  162.     }
  163.     if (car$wait==0) {
  164.       if (car$load==0) {
  165.         on=packageOn(car$x,car$y,packages)
  166.         if (on!=0) {
  167.           packages[on,5]=1
  168.           car$load=on
  169.         }
  170.       } else if (packages[car$load,3]==car$x && packages[car$load,4]==car$y) {
  171.         packages[car$load,5]=2
  172.         car$load=0
  173.         if (sum(packages[,5])==2*nrow(packages)) {
  174.           if (verbose)
  175.             cat("\nCongratulations! You suceeded in",i,"turns!")
  176.           return (i)
  177.         }
  178.       }
  179.       car=carReady(roads,car,packages)
  180.       car=processNextMove(car,roads,dim)
  181.     } else {
  182.       car$wait=car$wait-1
  183.     }
  184.     if (pause>0) Sys.sleep(pause)
  185.   }
  186.   cat("\nYou failed to complete the task. Try again.")
  187.   return (NA)
  188. }
  189. #' @keywords internal
  190. packageOn<-function(x,y,packages){
  191.   notpickedup=which(packages[,5]==0)
  192.   onX=which(packages[,1]==x)
  193.   onY=which(packages[,2]==y)
  194.   available=intersect(notpickedup,intersect(onX,onY))
  195.   if (length(available)!=0) {
  196.     return (available[1])
  197.   }
  198.   return (0)
  199. }
  200. #' @keywords internal
  201. processNextMove<-function(car,roads,dim) {
  202.   nextMove=car$nextMove
  203.   if (nextMove==8) {
  204.     if (car$y!=dim) {
  205.       car$wait=roads$vroads[car$x,car$y]
  206.       car$y=car$y+1
  207.     } else {
  208.       warning(paste("Cannot move up from y-position",car$y))
  209.     }
  210.   } else if (nextMove==2) {
  211.     if (car$y!=1) {
  212.       car$y=car$y-1
  213.       car$wait=roads$vroads[car$x,car$y]
  214.     } else {
  215.       warning(paste("Cannot move down from y-position",car$y))
  216.     }
  217.   }  else if (nextMove==4) {
  218.     if (car$x!=1) {
  219.       car$x=car$x-1
  220.       car$wait=roads$hroads[car$x,car$y]
  221.     } else {
  222.       warning(paste("Cannot move left from x-position",car$x))
  223.     }
  224.   }  else if (nextMove==6) {
  225.     if (car$x!=dim) {
  226.       car$wait=roads$hroads[car$x,car$y]
  227.       car$x=car$x+1
  228.     } else {
  229.       warning(paste("Cannot move right from x-position",car$x))
  230.     }
  231.   } else if (nextMove!=5) {
  232.     warning("Invalid move. No move made. Use 5 for deliberate no move.")
  233.   }
  234.   car$nextMove=NA
  235.   return (car)
  236. }
  237.  
  238. #' @keywords internal
  239. plotPackages=function(packages) {
  240.   notpickedup=which(packages[,5]==0)
  241.   notdelivered=which(packages[,5]!=2)
  242.   points(packages[notpickedup,1],packages[notpickedup,2],col="green",pch=18,cex=3)
  243.   points(packages[notdelivered,3],packages[notdelivered,4],col="red",pch=18,cex=3)
  244. }
  245.  
  246. #' @keywords internal
  247. makeDotGrid<-function(n,i) {
  248.   plot(rep(seq(1,n),each=n),rep(seq(1,n),n),xlab="X",ylab="Y",main=paste("Delivery Man. Turn ", i,".",sep=""))
  249. }
  250.  
  251. #' @keywords internal
  252. makeRoadMatrices<-function(n){
  253.   hroads=matrix(rep(1,n*(n-1)),nrow=n-1)
  254.   vroads=matrix(rep(1,(n-1)*n),nrow=n)
  255.   list(hroads=hroads,vroads=vroads)
  256. }
  257.  
  258. #' @keywords internal
  259. plotRoads<- function (hroads,vroads) {
  260.   for (row in 1:nrow(hroads)) {
  261.     for (col in 1:ncol(hroads)) {
  262.       lines(c(row,row+1),c(col,col),col=hroads[row,col])
  263.     }
  264.   }
  265.   for (row in 1:nrow(vroads)) {
  266.     for (col in 1:ncol(vroads)) {
  267.       lines(c(row,row),c(col,col+1),col=vroads[row,col])
  268.     }
  269.   }
  270. }
  271. #' @keywords internal
  272. updateRoads<-function(hroads,vroads) {
  273.   r1=runif(length(hroads))
  274.   r2=runif(length(hroads))
  275.   for (i in 1:length(hroads)) {
  276.     h=hroads[i]
  277.     if (h==1) {
  278.       if (r1[i]<.05) {
  279.         hroads[i]=2
  280.       }
  281.     }
  282.     else {
  283.       if (r1[i]<.05) {
  284.         hroads[i]=h-1
  285.       } else if (r1[i]<.1) {
  286.         hroads[i]=h+1
  287.       }
  288.     }
  289.     v=vroads[i]
  290.     if (v==1) {
  291.       if (r2[i]<.05) {
  292.         vroads[i]=2
  293.       }
  294.     }
  295.     else {
  296.       if (r2[i]<.05) {
  297.         vroads[i]=v-1
  298.       } else if (r2[i]<.1) {
  299.         vroads[i]=v+1
  300.       }
  301.     }
  302.   }
  303.   list (hroads=hroads,vroads=vroads)
  304. }
  305.  
  306.  
  307. manhattanDistance<-function(currX, currY, destX, destY) {
  308.   distance = 0
  309.   xDistance = abs(currX-destX)
  310.   yDistance = abs(currY-destY)
  311.   distance = sqrt(xDistance^2+yDistance^2)
  312.   return (round(distance))
  313. }
  314.  
  315. enFunktion<-function(roads, car, destX, destY) {
  316.   print(car$x)
  317.   print(car$y)
  318.   distList = 0
  319.   manDist = 0
  320.   if (car$x <= 9) {
  321.    
  322.     manDist[1] = manhattanDistance(car$x+1, car$y, destX, destY) + (roads$hroads[car$y, car$x+1]) else manDist[1] = 99
  323.  
  324.   }
  325.  
  326.  
  327.  
  328.   if (car$x >= 2 )manDist[2] = manhattanDistance(car$x-1, car$y, destX, destY) + (roads$hroads[car$y, car$x-1]) else manDist[2] = 99
  329.  
  330.   if (car$y <= 9) manDist[3] = manhattanDistance(car$x, car$y+1, destX, destY) + (roads$vroads[car$y+1, car$x]) else manDist[3] = 99
  331.  
  332.   if (car$y >= 2 ) manDist[4] = manhattanDistance(car$x, car$y-1, destX, destY) + (roads$vroads[car$y-1, car$x]) else manDist[4] = 99
  333.  
  334.   print(manDist)
  335.  
  336.  
  337.   return (list)
  338. }
  339.  
  340. # traffic = (hroads & vroads)
  341. # car = x,x-kordinater, load 0 = inget pkg, list-mem, nextMove
  342. # pkgInfo = matrix - 5 col, 1 row per/pkg
  343. # 2 first col = x & y kordinater var det skall hämtas
  344. # 2 nästa col = x & y vart det skall
  345. # sista = pkg status 0, not picked up, 1 picked up, 2 delivered
  346. carReady=function(roads, car, packages) {
  347.   nextMove=0
  348.   toGo=0
  349.   pkglist = 0
  350.   if (car$load==0) {
  351.     pkgList=which(packages[,5]==0)
  352.     dist = 10000
  353.     #Funktion för att välja det paketet som ligger närmast utan att ta trafiken till hänsyn
  354.     for (val in pkgList) {
  355.       tempDist = manhattanDistance(car$x, car$y, packages[val, 1], packages[val, 2])
  356.       enFunktion(roads, car, packages[val, 1], packages[val, 2])
  357.       if (tempDist < dist) {
  358.         dist = tempDist #manhattanDistance(car$x, car$y, packages[val][1], packages[val][2])
  359.         toGo = val #Vilket paket bilen skall åka mot när den inte har ett paket
  360.       }
  361.     }
  362.   if (car$x<packages[toGo,1]) {nextMove=6}
  363.   else if (car$x>packages[toGo,1]) {nextMove=4}
  364.   else if (car$y<packages[toGo,2]) {nextMove=8}
  365.   else if (car$y>packages[toGo,2]) {nextMove=2}
  366.   else {nextMove=5}
  367.   car$nextMove=nextMove
  368.   car$mem=list()
  369.  
  370.   }
  371.   else {
  372.     currPkg=car$load
  373.     if (car$x<packages[currPkg, 3]) {nextMove=6}
  374.     else if (car$x>packages[currPkg, 3]) {nextMove=4}
  375.     else if (car$y<packages[currPkg, 4]) {nextMove=8}
  376.     else if (car$y>packages[currPkg, 4]) {nextMove=2}
  377.     else {nextMove=5}
  378.     car$nextMove=nextMove
  379.     car$mem=list()
  380.   }
  381.   return (car)
  382.  
  383. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!