Job scheduler using greedy algorithm

gistfile1.rkt

(require racket/pretty)

(define (job start end) (list start end))

(define (job-with-duration start duration)
  (job start
       (+ start duration)))

(define (job-end job)
  (second job))

(define (job-start job)
  (first job))

(define (job-duration job)
  (- (job-end job)
     (job-start job)
     ))

(define (print-job job)
  (string-append
   "(job start: " (number->string (job-start job))
   " end: "       (number->string (job-end job)) ")"
   )
  )

(define (print-jobs jobs)
  (pretty-print (map print-job jobs)))

(define (random-jobs count)
  (for/list ([i (in-range count)])
            (job-with-duration (random 10)
                               (+ 2 (random 5)))))

(define (sort-jobs jobs prop)
  (sort jobs
        #:key prop
        <=))

(define (job-conflict? ljob rjob)
  (or
   (and
    (< (job-start rjob) (job-end ljob))
    (>= (job-start rjob) (job-start ljob)))
   (and
    (< (job-start ljob) (job-end rjob))
    (>= (job-start ljob) (job-start rjob)))
   ))

(define (job-has-conflicts? jobs job)
  (ormap (curry job-conflict? job)
         jobs))

(define (conflicts-with jobs job)
  (filter (curry job-conflict? job)
          jobs))

; Count the number of conflicts of job in jobs
(define (count-conflicts jobs job)
  (count (curry job-conflict? job)
         jobs))

; Produce the largest, non-conflicting subset of jobs
; Sort the jobs (by end time if you want optimal results)
; before calling!
(define (schedule jobs)
  (foldl (lambda (job result)
           (if (job-has-conflicts? result job)
               result
               (append result (list job))))
         '()
         jobs))

(let ([jobs (random-jobs 10)])
  (append
    (list "Jobs: " (sort-jobs jobs job-start) "\n")
    (map (lambda (sort-proc)
         (list "When sorting by:" (object-name sort-proc)
               (sort-jobs
                (schedule (sort-jobs jobs sort-proc))
                job-start)))
       (list job-end
             job-start
             job-duration
             (procedure-rename (curry count-conflicts jobs)
                               'number-of-conflicts)))))