Guest User

Untitled

a guest
Jun 19th, 2018
80
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.06 KB | None | 0 0
  1. (require racket/pretty)
  2.  
  3. (define (job start end) (list start end))
  4.  
  5. (define (job-with-duration start duration)
  6. (job start
  7. (+ start duration)))
  8.  
  9. (define (job-end job)
  10. (second job))
  11.  
  12. (define (job-start job)
  13. (first job))
  14.  
  15. (define (job-duration job)
  16. (- (job-end job)
  17. (job-start job)
  18. ))
  19.  
  20. (define (print-job job)
  21. (string-append
  22. "(job start: " (number->string (job-start job))
  23. " end: " (number->string (job-end job)) ")"
  24. )
  25. )
  26.  
  27. (define (print-jobs jobs)
  28. (pretty-print (map print-job jobs)))
  29.  
  30. (define (random-jobs count)
  31. (for/list ([i (in-range count)])
  32. (job-with-duration (random 10)
  33. (+ 2 (random 5)))))
  34.  
  35. (define (sort-jobs jobs prop)
  36. (sort jobs
  37. #:key prop
  38. <=))
  39.  
  40. (define (job-conflict? ljob rjob)
  41. (or
  42. (and
  43. (< (job-start rjob) (job-end ljob))
  44. (>= (job-start rjob) (job-start ljob)))
  45. (and
  46. (< (job-start ljob) (job-end rjob))
  47. (>= (job-start ljob) (job-start rjob)))
  48. ))
  49.  
  50. (define (job-has-conflicts? jobs job)
  51. (ormap (curry job-conflict? job)
  52. jobs))
  53.  
  54. (define (conflicts-with jobs job)
  55. (filter (curry job-conflict? job)
  56. jobs))
  57.  
  58. ; Count the number of conflicts of job in jobs
  59. (define (count-conflicts jobs job)
  60. (count (curry job-conflict? job)
  61. jobs))
  62.  
  63. ; Produce the largest, non-conflicting subset of jobs
  64. ; Sort the jobs (by end time if you want optimal results)
  65. ; before calling!
  66. (define (schedule jobs)
  67. (foldl (lambda (job result)
  68. (if (job-has-conflicts? result job)
  69. result
  70. (append result (list job))))
  71. '()
  72. jobs))
  73.  
  74. (let ([jobs (random-jobs 10)])
  75. (append
  76. (list "Jobs: " (sort-jobs jobs job-start) "\n")
  77. (map (lambda (sort-proc)
  78. (list "When sorting by:" (object-name sort-proc)
  79. (sort-jobs
  80. (schedule (sort-jobs jobs sort-proc))
  81. job-start)))
  82. (list job-end
  83. job-start
  84. job-duration
  85. (procedure-rename (curry count-conflicts jobs)
  86. 'number-of-conflicts)))))
Add Comment
Please, Sign In to add comment