pothole repair


A road maintenance department has a machine that can simultainously fix all potholes in a segment consisting of three consecutive road units. Write a function that accepts a road map represented by a string of characters '.' and 'X', where '.' represents a unit of road in good repair and 'X' represents a unit of road with a pothole, and returns the minimal number of segments needed to repair all potholes indicated by the map.

 $ cat prs.rkt  
 #lang racket 
  
 (define (poml roadway) 
  
   ; Return the minimal number of segments needed to fix all 
   ; potholes in the given roadway. 
  
   (let ((n (string-length roadway))) 
     (let loop ((location 0) (segments 0)) 
       (cond 
         ((>= location n) 
            segments) 
  
         ((char=? #\X (string-ref roadway location)) 
            (loop (+ location 3) (+ segments 1))) 
  
         (#t 
            (loop (+ location 1) segments)))))) 
  
  
 (require "pq.rkt") 
  
 (define (poml-bf roadway) 
  
   ; Return the minimal number of segments needed to fix all 
   ; potholes in the given roadway. 
  
   ; This is a brute-force algorithm, generating all possible 
   ; solutions and returning (one of the) best found. 
   ; Generating solutions is easy; given a partial solution s 
   ; considering roadway unit i, create a new partial 
   ; solution that adds a segment starting at i.  In 
   ; addition, if unit i doesn't have a pothole, create a new 
   ; partial solution with the same number of segments as s 
   ; and considers unit i + 1.  The search is juiced by 
   ; considering better partial solutions before worse 
   ; partial solutions.  Partial solution a is better than 
   ; partial solution b if 1) a uses fewer segments than b or 
   ; 2) a and b use the same number of segments and a is 
   ; further along the roadway than is b. 
    
   (let* 
  
     ((n (string-length roadway)) 
      (schedule-segment-count cdr) 
      (schedule-next-unit car) 
      (pq (pq-new 
            (lambda (a b) 
              (let  
                ((sc-a (schedule-segment-count a)) 
                 (sc-b (schedule-segment-count b)) 
                 (nu-a (schedule-next-unit a)) 
                 (nu-b (schedule-next-unit b))) 
  
                (or (< sc-a sc-b) 
                    (and (= sc-a sc-b) 
                         (> nu-a nu-b))))) 
           '((0 . 0))))) 
      
     (let loop () 
       (let* 
         ((e (pq-dq! pq)) 
          (nu (schedule-next-unit e)) 
          (sc (schedule-segment-count e))) 
  
        (if (>= nu n) 
           sc 
           (begin 
             (pq-nq! pq (cons (+ nu 3) (+ sc 1))) 
             (unless (char=? #\X (string-ref roadway nu)) 
               (pq-nq! pq (cons (+ nu 1) sc))) 
             (loop))))))) 
  
  
 (module+ test 
    
   (require rackunit) 
  
   (define (test f) 
     (check-equal? (f "") 0) 
     (check-equal? (f ".X.") 1) 
     (check-equal? (f ".X...X") 2) 
     (check-equal? (f "XXX.XXXX") 3) 
     (check-equal? (f ".X.XX.XX.X") 3)) 
  
   (test poml) 
   (test poml-bf) 
  
   (define (make-random-roadway) 
     (let* ((n (random 20)) 
            (r (make-string n))) 
       (do ((i 0 (+ i 1))) ((= i n) r) 
         (string-set! r i (if (< (random 10) 6) #\. #\X))))) 
  
   (do ((i 0 (+ i 1))) ((= i 100) (void)) 
     (let ((r (make-random-roadway))) 
       (check-equal? (poml r) (poml-bf r)))) 
   ) 
  
 $ raco test prs.rkt  
 raco test: (submod "prs.rkt" test) 
 110 tests passed 
  
 $