term-match/stream

[MichaelBurge]

Using redex patterns to implement a simplify method causes O(n) simplifications to each be evaluated O(n) times, for a total of O(n^2). The problem is that patterns are matched to all possible results, even if you only need the first.

What do you think about adding a term-match/stream(which could be used to implement term-match/first)? I suspect that it would reduce the number of swaps considered by the below bubble sort from O(n^3) to O(n^2).

#lang racket

(require redex/reduction-semantics)

(define-language L
  [ xs ::= (n ...) ]
  [ n ::= natural ]
  )

(define (until-equal f x)
  (let loop ([ x x ])
    (define x_i x)
    (define x_o (f x_i))
    (if (equal? x_i x_o)
        x_o
        (loop x_o))))

(define (fix-matches f x)
  (until-equal (λ (x)
                 (define matches (f x))
                 (if (null? matches)
                     x
                     (first matches)))
               x))

(define *swaps-redex* 0)

(define bubble-sort-pattern
  (let ()
    (define find-swappable
      (term-match
       L
       [(side-condition (n_1 ... n_2 n_3 n_4 ...)
                        (< (term n_2) (term n_3)))
        (begin (set! *swaps-redex* (+ *swaps-redex* 1))
               (term (n_1 ... n_3 n_2 n_4 ...)))]))
    (λ (e)
      (fix-matches find-swappable e)
      )))

(define l '(26 30 83 70 7 33 47 4 11 59 25 84 69 43 53 17 49 92 2 81 77 24 63 15 68 90 72 40 48 58 78 3 16 62 79 85 8 96 97 57 56 13 19 46 76 67 21 44 95 60 86 31 38 65 89 39 5 80 36 14 41 75 71 55 22 98 87 10 29 23 64 35 93 34 61 74 6 50 52 94 37 54 91 99 28 9 82 27 42 73 88 20 18 0 1 66 45 12 51 32))

(bubble-sort-pattern l)

`(SWAPS ,*swaps-redex*) ; Prints 48576

The above bubble-sort considers 48576 swaps, while the below one considers 2512 swaps.

(define *swaps-handrolled* 0)
(define (bubble-sort <? v)
  (define len (vector-length v))
  (define ref vector-ref)
  (let loop ([max len]
             [again? #f])
    (for ([i (in-range 0 (- max 1))]
          [j (in-range 1 max)])
      (define vi (ref v i))
      (when (<? (ref v j) vi)
        (set! *swaps-handrolled* (+ *swaps-handrolled* 1))
        (vector-set! v i (ref v j))
        (vector-set! v j vi)
        (set! again? #t)))
    (when again? (loop (- max 1) #f)))
  v)

(define l '(26 30 83 70 7 33 47 4 11 59 25 84 69 43 53 17 49 92 2 81 77 24 63 15 68 90 72 40 48 58 78 3 16 62 79 85 8 96 97 57 56 13 19 46 76 67 21 44 95 60 86 31 38 65 89 39 5 80 36 14 41 75 71 55 22 98 87 10 29 23 64 35 93 34 61 74 6 50 52 94 37 54 91 99 28 9 82 27 42 73 88 20 18 0 1 66 45 12 51 32))

(bubble-sort < (list->vector l))

`(SWAPS ,*swaps-handrolled*) ; Prints 2512

The pattern matches themselves would still start at the beginning of the S-expression each time, so there would still be a "Schlemiel the Painter's Algorithm" in many cases. It should still be an improvement, though.

That could be avoided if pattern matches exposed some notion of progress, and if that progress could be transferred to a new term. The bubble-sort function's progress is its index in the vector. Starting a pattern match search at a random location in the S-expression might also work.