Do Values Grow on Trees?: The Expression Integrity Metric

expression_integrity_metric.rkt

;; 
;; The code implementing the expression integrity metric presented in
;;
;;    Do Values Grow on Trees?: Expression Integrity in Functional Programming
;;    Guillaume Marceau, Kathi Fisler, Shriram Krishnamurthi
;;    SIGCSE International Computing Education Research Workshop, 2011
;;
;; http://gmarceau.qc.ca/papers/Marceau-2011-Do-Values-Grow-on-Trees.pdf
;;

(define (A* base-case generate-subs v)
  (define memo (make-hash))
  (let loop ([v v] [prev-best +inf.0])
    (cond [(base-case v) => identity]
          [(hash-ref memo v #f) => identity]
          [(= prev-best 0) #f]
          [else
           (let ()
             (define subs (generate-subs v))
             (define-values (result found)
               (for/fold ([prev-best prev-best] [found #f]) ([sub subs])
                 (match-define (list sub-v sub-cost) sub)
                 (define result (loop sub-v (- prev-best sub-cost)))
                 (if result
                     (values (min (+ result sub-cost) prev-best) #t)
                     (values prev-best found))))
             (when found (hash-set! memo v result))
             (and found result))])))

(test 'A*
      (define (base-case v) (and (integer? v) v))
      (define (recursive-case v) (map (lambda (i) (list i 1)) v))
      (check-equal? (A* base-case recursive-case
                        '((8 9) ((1 2 (0 (0)) 3 4) 3) (((1 2 (0 (0)) 3 4) 3) 0 6)))
                    2.0))



(define (amount-of-unbalancing shape)
  
  (define (find-first-bad-match shape)
    (ormap (lambda (b) (and (regexp-match (regexp-quote b) shape) b)) bad-matches))
  
  (define (find-first-good-match shape)
    (ormap (lambda (g) (and (regexp-match? g shape) g)) good-matches))
  
  (define (base-case shape)
    (cond [(equal? shape "") 0]
          [(and (not (find-first-good-match shape)) (not (find-first-bad-match shape)))
           (string-length shape)]
          [else #f]))
  
  (define (recursive-case shape)
    (cond [(find-first-good-match shape)
           =>
           (lambda (g) (list (list (regexp-replace g shape "") 0)))]
          [(find-first-bad-match shape)
           =>
           (lambda (match)
             (for/list ([sub (list ""
                                   (string (string-ref match 0))
                                   (string (string-ref match 1)))])
               (list (regexp-replace (regexp-quote match) shape sub) 1)))]))
  
  (inexact->exact (A* base-case recursive-case shape)))

(test 'amount-of-unbalancing
      (check-equal? (amount-of-unbalancing "()[((())){{{}}}]") 0)
      (check-equal? (amount-of-unbalancing "()[))){{{}}}]") 3)
      (check-equal? (amount-of-unbalancing "([[[)((") 5)
      (check-equal? (amount-of-unbalancing "){)()[]{}[}[") 4)
      (check-equal? (amount-of-unbalancing "([)") 1)
      (check-equal? (amount-of-unbalancing "(])") 1)
      (check-equal? (amount-of-unbalancing "([)") 1)
      (check-equal? (amount-of-unbalancing "(])") 1)
      (check-equal? (amount-of-unbalancing "(][)") 2) ;; assumption here: nobody puts parentheses backward by mistake
      (check-equal? (amount-of-unbalancing "(]))") 2)
      (check-equal? (amount-of-unbalancing "([))") 1))